From 4321f2847015ac2f9e4fdac2394976fc2cd7832d Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Sun, 24 Nov 2019 09:16:53 -0500 Subject: [PATCH] Clean up some code smells in D.S.{Promote,Single}.Defun While looking at the defunctionalization code recently, I discovered several smelly aspects of the code. This patch does not fix all such code smells (I plan to tackle more of them while tackling #378), but this does pick some of the lower-hanging fruit. Here are the highlights: 1. The `reverse` function is used an awful lot in `D.S.Promote.Defun.defunctionalize`. It's used here, when the inner loop (`go`) is first invoked: https://github.com/goldfirere/singletons/blob/2ec18435b8c57afcfcec0b7da872621b1179d45f/src/Data/Singletons/Promote/Defun.hs#L299 And it's also used here, inside of `go` itself: https://github.com/goldfirere/singletons/blob/2ec18435b8c57afcfcec0b7da872621b1179d45f/src/Data/Singletons/Promote/Defun.hs#L237-L240 This makes my head spin. Moreover, there other some parts of `go` that use `m_args` instead of using `reverse m_args`, which causes some odd-looking code to be generated (e.g., generating both `data BlahSym2 x y :: z ~> Type` _and_ `type instance Apply (BlahSym2 y x) z = BlahSym3 y x z`). None of this is technially wrong, but I find it hard to follow. Luckily, we can get away without needing either use of `reverse`. Instead of processing a single list of `TyVarBndr`s in reverse order inside of `go`, we can track two lists of `TyVarBndr`s. To how this works, imagine we are to generate these defunctionalization symbols: ```hs data BlahSym0 :: x ~> y ~> z ~> Type data BlahSym1 x :: y ~> z ~> Type data BlahSym2 x y :: z ~> Type ``` We can accomplish this by "cycling" through the `TyVarBndr`s with two lists: one for the arguments and another for the result kind. Or, in code: ```hs [] [x, y, z] -- BlahSym0 [x] [y, z] -- BlahSym1 [x, y] [z] -- BlahSym2 ``` Notice that at each iteration of `go`, we take the first `TyVarBndr` from the second list and append it to the end of the first. This makes `go` run in quadratic time, but this is not a new precedent, since `go` was quadratic before due to invoking `reverse` in each iteration. Given the choice between these two quadratic-time designs, I prefer the new one. I've applied this refactor to the `go` functions in `D.S.Promote.Defun.defunctionalize` and `D.S.Single.Defun.singDefuns`, and left some comments explaining what is going on. 2. The inner loop of `D.S.Promote.Defun.defunctionalize` works by starting from `n - 1` (where `n` is the number of arguments) and iterating until `0` is reached. On the flip side, the inner loop of `D.S.Single.Defun.singDefuns` works by starting from `0` and iterating until `n - 1` is reached. For the sake of consistency, I have adopted the `singDefuns` convention (start from `0` and count up) for both pieces of code. 3. The inner loops of `D.S.Promote.Defun.defunctionalize` and `D.S.Single.Defun.singDefuns` are monadic, but they don't need to be. The only monadic things they do are generate unique names, but this can be done more easily outside of the inner loops themselves. This patch refactors the code to do just that, making the inner loop code pure. A consequence of (2) is that `D.S.Promote.Defun.defunctionalize` now generates defunctionalization symbols in the opposite order that it used to. This causes many, many test cases to have different expected output, making the patch appear larger than it actually is. --- src/Data/Singletons/Promote/Defun.hs | 63 +- src/Data/Singletons/Single/Defun.hs | 99 +- .../GradingClient/Database.golden | 298 ++-- .../InsertionSort/InsertionSortImp.golden | 82 +- .../Promote/Constructors.golden | 84 +- .../Promote/GenDefunSymbols.golden | 46 +- .../compile-and-dump/Promote/Newtypes.golden | 12 +- tests/compile-and-dump/Promote/Prelude.golden | 4 +- tests/compile-and-dump/Promote/T180.golden | 12 +- tests/compile-and-dump/Promote/T361.golden | 4 +- .../Singletons/AsPattern.golden | 144 +- .../Singletons/BoundedDeriving.golden | 24 +- .../Singletons/BoxUnBox.golden | 8 +- .../Singletons/CaseExpressions.golden | 158 +- .../Singletons/Classes.golden | 252 ++-- .../Singletons/Classes2.golden | 26 +- .../Singletons/Contains.golden | 22 +- .../Singletons/DataValues.golden | 62 +- .../Singletons/EmptyShowDeriving.golden | 36 +- .../Singletons/EnumDeriving.golden | 16 +- .../compile-and-dump/Singletons/Error.golden | 4 +- .../compile-and-dump/Singletons/Fixity.golden | 52 +- .../Singletons/FunDeps.golden | 16 +- .../Singletons/FunctorLikeDeriving.golden | 1344 ++++++++--------- .../Singletons/HigherOrder.golden | 276 ++-- .../Singletons/LambdaCase.golden | 150 +- .../Singletons/Lambdas.golden | 566 +++---- .../Singletons/LambdasComprehensive.golden | 4 +- .../Singletons/LetStatements.golden | 358 ++--- .../compile-and-dump/Singletons/Maybe.golden | 42 +- tests/compile-and-dump/Singletons/Nat.golden | 86 +- .../Singletons/Operators.golden | 42 +- .../Singletons/OrdDeriving.golden | 408 ++--- .../Singletons/OverloadedStrings.golden | 4 +- .../Singletons/PatternMatching.golden | 210 +-- .../Singletons/PolyKinds.golden | 4 +- .../Singletons/Records.golden | 30 +- .../Singletons/ReturnFunc.golden | 46 +- .../Singletons/Sections.golden | 24 +- .../Singletons/ShowDeriving.golden | 222 +-- .../Singletons/StandaloneDeriving.golden | 154 +- tests/compile-and-dump/Singletons/Star.golden | 82 +- tests/compile-and-dump/Singletons/T124.golden | 4 +- tests/compile-and-dump/Singletons/T136.golden | 16 +- .../compile-and-dump/Singletons/T136b.golden | 8 +- tests/compile-and-dump/Singletons/T145.golden | 22 +- tests/compile-and-dump/Singletons/T159.golden | 92 +- tests/compile-and-dump/Singletons/T160.golden | 8 +- tests/compile-and-dump/Singletons/T163.golden | 8 +- tests/compile-and-dump/Singletons/T166.golden | 68 +- tests/compile-and-dump/Singletons/T167.golden | 122 +- tests/compile-and-dump/Singletons/T172.golden | 20 +- tests/compile-and-dump/Singletons/T176.golden | 74 +- tests/compile-and-dump/Singletons/T178.golden | 58 +- tests/compile-and-dump/Singletons/T183.golden | 136 +- tests/compile-and-dump/Singletons/T184.golden | 366 ++--- tests/compile-and-dump/Singletons/T187.golden | 22 +- tests/compile-and-dump/Singletons/T190.golden | 66 +- tests/compile-and-dump/Singletons/T197.golden | 24 +- .../compile-and-dump/Singletons/T197b.golden | 48 +- tests/compile-and-dump/Singletons/T200.golden | 80 +- tests/compile-and-dump/Singletons/T209.golden | 38 +- tests/compile-and-dump/Singletons/T216.golden | 64 +- tests/compile-and-dump/Singletons/T229.golden | 4 +- tests/compile-and-dump/Singletons/T249.golden | 12 +- tests/compile-and-dump/Singletons/T271.golden | 46 +- tests/compile-and-dump/Singletons/T287.golden | 82 +- tests/compile-and-dump/Singletons/T29.golden | 16 +- tests/compile-and-dump/Singletons/T297.golden | 2 +- tests/compile-and-dump/Singletons/T312.golden | 144 +- tests/compile-and-dump/Singletons/T313.golden | 24 +- tests/compile-and-dump/Singletons/T316.golden | 38 +- tests/compile-and-dump/Singletons/T322.golden | 24 +- tests/compile-and-dump/Singletons/T33.golden | 4 +- tests/compile-and-dump/Singletons/T332.golden | 4 +- tests/compile-and-dump/Singletons/T342.golden | 2 +- tests/compile-and-dump/Singletons/T353.golden | 102 +- tests/compile-and-dump/Singletons/T358.golden | 16 +- tests/compile-and-dump/Singletons/T367.golden | 26 +- tests/compile-and-dump/Singletons/T371.golden | 82 +- tests/compile-and-dump/Singletons/T376.golden | 20 +- .../compile-and-dump/Singletons/T378a.golden | 24 +- tests/compile-and-dump/Singletons/T402.golden | 4 +- tests/compile-and-dump/Singletons/T410.golden | 46 +- tests/compile-and-dump/Singletons/T412.golden | 194 +-- tests/compile-and-dump/Singletons/T414.golden | 40 +- tests/compile-and-dump/Singletons/T54.golden | 6 +- tests/compile-and-dump/Singletons/T78.golden | 4 +- .../Singletons/TopLevelPatterns.golden | 38 +- .../compile-and-dump/Singletons/Undef.golden | 8 +- 90 files changed, 3997 insertions(+), 3935 deletions(-) diff --git a/src/Data/Singletons/Promote/Defun.hs b/src/Data/Singletons/Promote/Defun.hs index 5ad680b2..ce702e91 100644 --- a/src/Data/Singletons/Promote/Defun.hs +++ b/src/Data/Singletons/Promote/Defun.hs @@ -215,6 +215,7 @@ defunctionalize :: Name defunctionalize name m_fixity m_arg_tvbs' m_res_kind' = do (m_arg_tvbs, m_res_kind) <- eta_expand (noExactTyVars m_arg_tvbs') (noExactTyVars m_res_kind') + extra_name <- qNewName "arg" let -- Implements part (2)(i) from Note [Defunctionalization and dependent quantification] tvb_to_type_map :: Map Name DType @@ -224,20 +225,52 @@ defunctionalize name m_fixity m_arg_tvbs' m_res_kind' = do map dTyVarBndrToDType m_arg_tvbs ++ maybeToList m_res_kind -- (2)(i)(a) - go :: Int -> [DTyVarBndr] -> Maybe DKind - -> PrM [DDec] - go _ [] _ = return [] - go n (m_arg : m_args) m_result = do - extra_name <- qNewName "arg" - let tyfun_name = extractTvbName m_arg + -- The inner loop. @go n arg_tvbs res_tvbs@ returns @(m_result, decls)@. + -- Using one particular example: + -- + -- @ + -- data ExampleSym2 (x :: a) (y :: b) :: c ~> d ~> Type where ... + -- type instance Apply (ExampleSym2 x y) z = ExampleSym3 x y z + -- ... + -- @ + -- + -- We have: + -- + -- * @n@ is 2. This is incremented in each iteration of `go`. + -- + -- * @arg_tvbs@ is [(x :: a), (y :: b)]. + -- + -- * @res_tvbs@ is [(z :: c), (w :: d)]. The kinds of these type variable + -- binders appear in the result kind. + -- + -- * @m_result@ is `Just (c ~> d ~> Type)`. @m_result@ is returned so + -- that earlier defunctionalization symbols can build on the result + -- kinds of later symbols. For instance, ExampleSym1 would get the + -- result kind `b ~> c ~> d ~> Type` by prepending `b` to ExampleSym2's + -- result kind `c ~> d ~> Type`. + -- + -- * @decls@ are all of the declarations corresponding to ExampleSym2 + -- and later defunctionalization symbols. This is the main payload of + -- the function. + -- + -- This function is quadratic because it appends a variable at the end of + -- the @arg_tvbs@ list at each iteration. In practice, this is unlikely + -- to be a performance bottleneck since the number of arguments rarely + -- gets to be that large. + go :: Int -> [DTyVarBndr] -> [DTyVarBndr] + -> (Maybe DKind, [DDec]) + go _ _ [] = (m_res_kind, []) + go n arg_tvbs (res_tvb:res_tvbs) = + let (m_result, decls) = go (n+1) (arg_tvbs ++ [res_tvb]) res_tvbs + + tyfun_name = extractTvbName res_tvb data_name = promoteTySym name n next_name = promoteTySym name (n+1) con_name = prefixName "" ":" $ suffixName "KindInference" "###" data_name - m_tyfun = buildTyFunArrow_maybe (extractTvbKind m_arg) m_result + m_tyfun = buildTyFunArrow_maybe (extractTvbKind res_tvb) m_result arg_params = -- Implements part (2)(ii) from -- Note [Defunctionalization and dependent quantification] - map (map_tvb_kind (substType tvb_to_type_map)) $ - reverse m_args + map (map_tvb_kind (substType tvb_to_type_map)) arg_tvbs arg_names = map extractTvbName arg_params params = arg_params ++ [DPlainTV tyfun_name] con_eq_ct = DConT sameKindName `DAppT` lhs `DAppT` rhs @@ -270,12 +303,12 @@ defunctionalize name m_fixity m_arg_tvbs' m_res_kind' = do map tvb_to_type $ -- (2)(iii)(b) toList $ fvDType tyfun -- (2)(iii)(a) in (arg_params, Just (DForallT ForallInvis tyfun_tvbs tyfun)) - app_data_ty = foldTypeTvbs (DConT data_name) m_args + app_data_ty = foldTypeTvbs (DConT data_name) arg_tvbs app_eqn = DTySynEqn Nothing (DConT applyName `DAppT` app_data_ty `DAppT` DVarT tyfun_name) (foldTypeTvbs (DConT next_name) - (m_args ++ [DPlainTV tyfun_name])) + (arg_tvbs ++ [DPlainTV tyfun_name])) app_decl = DTySynInstD app_eqn suppress = DInstanceD Nothing Nothing [] (DConT suppressClassName `DAppT` app_data_ty) @@ -287,17 +320,15 @@ defunctionalize name m_fixity m_arg_tvbs' m_res_kind' = do -- See Note [Fixity declarations for defunctionalization symbols] fixity_decl = maybeToList $ fmap (mk_fix_decl data_name) m_fixity - - decls <- go (n - 1) m_args m_tyfun - return $ suppress : data_decl : app_decl : fixity_decl ++ decls + in (m_tyfun, suppress : data_decl : app_decl : fixity_decl ++ decls) let num_args = length m_arg_tvbs sat_name = promoteTySym name num_args sat_dec = DTySynD sat_name m_arg_tvbs $ foldTypeTvbs (DConT name) m_arg_tvbs sat_fixity_dec = maybeToList $ fmap (mk_fix_decl sat_name) m_fixity - other_decs <- go (num_args - 1) (reverse m_arg_tvbs) m_res_kind - return $ sat_dec : sat_fixity_dec ++ other_decs + (_, other_decs) = go 0 [] m_arg_tvbs + return $ other_decs ++ sat_dec : sat_fixity_dec where eta_expand :: [DTyVarBndr] -> Maybe DKind -> PrM ([DTyVarBndr], Maybe DKind) eta_expand m_arg_tvbs Nothing = pure (m_arg_tvbs, Nothing) diff --git a/src/Data/Singletons/Single/Defun.hs b/src/Data/Singletons/Single/Defun.hs index 6993a371..92c2b688 100644 --- a/src/Data/Singletons/Single/Defun.hs +++ b/src/Data/Singletons/Single/Defun.hs @@ -13,6 +13,7 @@ module Data.Singletons.Single.Defun (singDefuns) where +import Control.Monad import Data.List import Data.Singletons.Names import Data.Singletons.Promote.Defun @@ -57,31 +58,61 @@ singDefuns n ns ty_ctxt mb_ty_args mb_ty_res = [] -> pure [] -- If a function has no arguments, then it has no -- defunctionalization symbols, so there's nothing to be done. _ -> do sty_ctxt <- mapM singPred ty_ctxt - go 0 sty_ctxt [] mb_ty_args + names <- replicateM (length mb_ty_args) $ qNewName "d" + let tvbs = zipWith inferMaybeKindTV names mb_ty_args + (_, insts) = go 0 sty_ctxt [] tvbs + pure insts where num_ty_args :: Int num_ty_args = length mb_ty_args - -- Sadly, this algorithm is quadratic, because in each iteration of the loop - -- we must: + -- The inner loop. @go n ctxt arg_tvbs res_tvbs@ returns @(m_result, insts)@. + -- Using one particular example: -- - -- * Construct an arrow type of the form (a ~> ... ~> z), using a suffix of - -- the promoted argument types. - -- * Append a new type variable to the end of an ordered list. + -- @ + -- instance (SingI a, SingI b, SEq c, SEq d) => + -- SingI (ExampleSym2 (x :: a) (y :: b) :: c ~> d ~> Type) where ... + -- @ -- - -- In practice, this is unlikely to be a bottleneck, as singletons does not - -- support functions with more than 7 or so arguments anyways. - go :: Int -> DCxt -> [DTyVarBndr] -> [Maybe DKind] -> SgM [DDec] - go sym_num sty_ctxt tvbs mb_tyss - | sym_num < num_ty_args - , mb_ty:mb_tys <- mb_tyss - = do new_tvb_name <- qNewName "d" - let new_tvb = inferMaybeKindTV new_tvb_name mb_ty - insts <- go (sym_num + 1) sty_ctxt (tvbs ++ [new_tvb]) mb_tys - pure $ new_insts ++ insts - | otherwise - = pure [] + -- We have: + -- + -- * @n@ is 2. This is incremented in each iteration of `go`. + -- + -- * @ctxt@ is (SEq c, SEq d). The (SingI a, SingI b) part of the instance + -- context is added separately. + -- + -- * @arg_tvbs@ is [(x :: a), (y :: b)]. + -- + -- * @res_tvbs@ is [(z :: c), (w :: d)]. The kinds of these type variable + -- binders appear in the result kind. + -- + -- * @m_result@ is `Just (c ~> d ~> Type)`. @m_result@ is returned so + -- that earlier defunctionalization symbols can build on the result + -- kinds of later symbols. For instance, ExampleSym1 would get the + -- result kind `b ~> c ~> d ~> Type` by prepending `b` to ExampleSym2's + -- result kind `c ~> d ~> Type`. + -- + -- * @insts@ are all of the instance declarations corresponding to + -- ExampleSym2 and later defunctionalization symbols. This is the main + -- payload of the function. + -- + -- This function is quadratic because it appends a variable at the end of + -- the @arg_tvbs@ list at each iteration. In practice, this is unlikely + -- to be a performance bottleneck since the number of arguments rarely + -- gets to be that large. + go :: Int -> DCxt -> [DTyVarBndr] -> [DTyVarBndr] + -> (Maybe DKind, [DDec]) + go _ _ _ [] = (mb_ty_res, []) + go sym_num sty_ctxt arg_tvbs (res_tvb:res_tvbs) = + (mb_new_res, new_inst:insts) where + mb_res :: Maybe DKind + insts :: [DDec] + (mb_res, insts) = go (sym_num + 1) sty_ctxt (arg_tvbs ++ [res_tvb]) res_tvbs + + mb_new_res :: Maybe DKind + mb_new_res = mk_inst_kind res_tvb mb_res + sing_fun_num :: Int sing_fun_num = num_ty_args - sym_num @@ -89,19 +120,19 @@ singDefuns n ns ty_ctxt mb_ty_args mb_ty_res = mk_sing_fun_expr sing_expr = foldl' (\f tvb_n -> f `DAppE` (DVarE singMethName `DAppTypeE` DVarT tvb_n)) sing_expr - (map extractTvbName tvbs) + (map extractTvbName arg_tvbs) singI_ctxt :: DCxt - singI_ctxt = map (DAppT (DConT singIName) . tvbToType) tvbs + singI_ctxt = map (DAppT (DConT singIName) . tvbToType) arg_tvbs mk_inst_ty :: DType -> DType mk_inst_ty inst_head - = case mb_inst_kind of + = case mb_new_res of Just inst_kind -> inst_head `DSigT` inst_kind Nothing -> inst_head - tvb_tys :: [DType] - tvb_tys = map dTyVarBndrToDType tvbs + arg_tvb_tys :: [DType] + arg_tvb_tys = map dTyVarBndrToDType arg_tvbs -- Construct the arrow kind used to annotate the defunctionalization -- symbol (e.g., the `a ~> a ~> Bool` in @@ -109,19 +140,19 @@ singDefuns n ns ty_ctxt mb_ty_args mb_ty_res = -- If any of the argument kinds or result kind isn't known (i.e., is -- Nothing), then we opt not to construct this arrow kind altogether. -- See Note [singDefuns and type inference] - mb_inst_kind :: Maybe DType - mb_inst_kind = foldr buildTyFunArrow_maybe mb_ty_res mb_tyss - - new_insts :: [DDec] - new_insts = [DInstanceD Nothing Nothing - (sty_ctxt ++ singI_ctxt) - (DConT singIName `DAppT` mk_inst_ty defun_inst_ty) - [DLetDec $ DValD (DVarP singMethName) - $ wrapSingFun sing_fun_num defun_inst_ty - $ mk_sing_fun_expr sing_exp ]] + mk_inst_kind :: DTyVarBndr -> Maybe DKind -> Maybe DKind + mk_inst_kind tvb' = buildTyFunArrow_maybe (extractTvbKind tvb') + + new_inst :: DDec + new_inst = DInstanceD Nothing Nothing + (sty_ctxt ++ singI_ctxt) + (DConT singIName `DAppT` mk_inst_ty defun_inst_ty) + [DLetDec $ DValD (DVarP singMethName) + $ wrapSingFun sing_fun_num defun_inst_ty + $ mk_sing_fun_expr sing_exp ] where defun_inst_ty :: DType - defun_inst_ty = foldType (DConT (promoteTySym n sym_num)) tvb_tys + defun_inst_ty = foldType (DConT (promoteTySym n sym_num)) arg_tvb_tys sing_exp :: DExp sing_exp = case ns of diff --git a/tests/compile-and-dump/GradingClient/Database.golden b/tests/compile-and-dump/GradingClient/Database.golden index 93783a2f..289eb8c7 100644 --- a/tests/compile-and-dump/GradingClient/Database.golden +++ b/tests/compile-and-dump/GradingClient/Database.golden @@ -8,8 +8,6 @@ GradingClient/Database.hs:(0,0)-(0,0): Splicing declarations = Zero | Succ Nat deriving (Eq, Ord) type ZeroSym0 = Zero - type SuccSym1 (t0123456789876543210 :: Nat) = - Succ t0123456789876543210 instance SuppressUnusedWarnings SuccSym0 where suppressUnusedWarnings = snd (((,) SuccSym0KindInference) ()) data SuccSym0 :: (~>) Nat Nat @@ -18,13 +16,22 @@ GradingClient/Database.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply SuccSym0 arg) (SuccSym1 arg) => SuccSym0 t0123456789876543210 type instance Apply SuccSym0 t0123456789876543210 = SuccSym1 t0123456789876543210 + type SuccSym1 (t0123456789876543210 :: Nat) = + Succ t0123456789876543210 type family Compare_0123456789876543210 (a :: Nat) (a :: Nat) :: Ordering where Compare_0123456789876543210 Zero Zero = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] Compare_0123456789876543210 (Succ a_0123456789876543210) (Succ b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[]) Compare_0123456789876543210 Zero (Succ _) = LTSym0 Compare_0123456789876543210 (Succ _) Zero = GTSym0 - type Compare_0123456789876543210Sym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) = - Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Compare_0123456789876543210Sym0KindInference) ()) + data Compare_0123456789876543210Sym0 :: (~>) Nat ((~>) Nat Ordering) + where + Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => + Compare_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 instance SuppressUnusedWarnings (Compare_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Compare_0123456789876543210Sym1KindInference) ()) @@ -35,15 +42,8 @@ GradingClient/Database.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Compare_0123456789876543210Sym1 a0123456789876543210) arg) (Compare_0123456789876543210Sym2 a0123456789876543210 arg) => Compare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Compare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Compare_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd (((,) Compare_0123456789876543210Sym0KindInference) ()) - data Compare_0123456789876543210Sym0 :: (~>) Nat ((~>) Nat Ordering) - where - Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => - Compare_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 + type Compare_0123456789876543210Sym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) = + Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance POrd Nat where type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a type family Equals_0123456789876543210 (a :: Nat) (b :: Nat) :: Bool where @@ -232,8 +232,14 @@ GradingClient/Database.hs:(0,0)-(0,0): Splicing declarations type BOOLSym0 = BOOL type STRINGSym0 = STRING type NATSym0 = NAT - type VECSym2 (t0123456789876543210 :: U) (t0123456789876543210 :: Nat) = - VEC t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings VECSym0 where + suppressUnusedWarnings = snd (((,) VECSym0KindInference) ()) + data VECSym0 :: (~>) U ((~>) Nat U) + where + VECSym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply VECSym0 arg) (VECSym1 arg) => + VECSym0 t0123456789876543210 + type instance Apply VECSym0 t0123456789876543210 = VECSym1 t0123456789876543210 instance SuppressUnusedWarnings (VECSym1 t0123456789876543210) where suppressUnusedWarnings = snd (((,) VECSym1KindInference) ()) data VECSym1 (t0123456789876543210 :: U) :: (~>) Nat U @@ -243,14 +249,8 @@ GradingClient/Database.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (VECSym1 t0123456789876543210) arg) (VECSym2 t0123456789876543210 arg) => VECSym1 t0123456789876543210 t0123456789876543210 type instance Apply (VECSym1 t0123456789876543210) t0123456789876543210 = VECSym2 t0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings VECSym0 where - suppressUnusedWarnings = snd (((,) VECSym0KindInference) ()) - data VECSym0 :: (~>) U ((~>) Nat U) - where - VECSym0KindInference :: forall t0123456789876543210 - arg. SameKind (Apply VECSym0 arg) (VECSym1 arg) => - VECSym0 t0123456789876543210 - type instance Apply VECSym0 t0123456789876543210 = VECSym1 t0123456789876543210 + type VECSym2 (t0123456789876543210 :: U) (t0123456789876543210 :: Nat) = + VEC t0123456789876543210 t0123456789876543210 type CASym0 = CA type CBSym0 = CB type CCSym0 = CC @@ -277,8 +277,14 @@ GradingClient/Database.hs:(0,0)-(0,0): Splicing declarations type CXSym0 = CX type CYSym0 = CY type CZSym0 = CZ - type AttrSym2 (t0123456789876543210 :: [AChar]) (t0123456789876543210 :: U) = - Attr t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings AttrSym0 where + suppressUnusedWarnings = snd (((,) AttrSym0KindInference) ()) + data AttrSym0 :: (~>) [AChar] ((~>) U Attribute) + where + AttrSym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply AttrSym0 arg) (AttrSym1 arg) => + AttrSym0 t0123456789876543210 + type instance Apply AttrSym0 t0123456789876543210 = AttrSym1 t0123456789876543210 instance SuppressUnusedWarnings (AttrSym1 t0123456789876543210) where suppressUnusedWarnings = snd (((,) AttrSym1KindInference) ()) data AttrSym1 (t0123456789876543210 :: [AChar]) :: (~>) U Attribute @@ -288,16 +294,8 @@ GradingClient/Database.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (AttrSym1 t0123456789876543210) arg) (AttrSym2 t0123456789876543210 arg) => AttrSym1 t0123456789876543210 t0123456789876543210 type instance Apply (AttrSym1 t0123456789876543210) t0123456789876543210 = AttrSym2 t0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings AttrSym0 where - suppressUnusedWarnings = snd (((,) AttrSym0KindInference) ()) - data AttrSym0 :: (~>) [AChar] ((~>) U Attribute) - where - AttrSym0KindInference :: forall t0123456789876543210 - arg. SameKind (Apply AttrSym0 arg) (AttrSym1 arg) => - AttrSym0 t0123456789876543210 - type instance Apply AttrSym0 t0123456789876543210 = AttrSym1 t0123456789876543210 - type SchSym1 (t0123456789876543210 :: [Attribute]) = - Sch t0123456789876543210 + type AttrSym2 (t0123456789876543210 :: [AChar]) (t0123456789876543210 :: U) = + Attr t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings SchSym0 where suppressUnusedWarnings = snd (((,) SchSym0KindInference) ()) data SchSym0 :: (~>) [Attribute] Schema @@ -306,24 +304,34 @@ GradingClient/Database.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply SchSym0 arg) (SchSym1 arg) => SchSym0 t0123456789876543210 type instance Apply SchSym0 t0123456789876543210 = SchSym1 t0123456789876543210 - type Let0123456789876543210Scrutinee_0123456789876543210Sym4 name0123456789876543210 name'0123456789876543210 u0123456789876543210 attrs0123456789876543210 = - Let0123456789876543210Scrutinee_0123456789876543210 name0123456789876543210 name'0123456789876543210 u0123456789876543210 attrs0123456789876543210 - instance SuppressUnusedWarnings (Let0123456789876543210Scrutinee_0123456789876543210Sym3 u0123456789876543210 name'0123456789876543210 name0123456789876543210) where + type SchSym1 (t0123456789876543210 :: [Attribute]) = + Sch t0123456789876543210 + instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) - Let0123456789876543210Scrutinee_0123456789876543210Sym3KindInference) + Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference) ()) - data Let0123456789876543210Scrutinee_0123456789876543210Sym3 name0123456789876543210 name'0123456789876543210 u0123456789876543210 attrs0123456789876543210 + data Let0123456789876543210Scrutinee_0123456789876543210Sym0 name0123456789876543210 where - Let0123456789876543210Scrutinee_0123456789876543210Sym3KindInference :: forall name0123456789876543210 + Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference :: forall name0123456789876543210 + arg. SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) => + Let0123456789876543210Scrutinee_0123456789876543210Sym0 name0123456789876543210 + type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 name0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210Sym1 name0123456789876543210 + instance SuppressUnusedWarnings (Let0123456789876543210Scrutinee_0123456789876543210Sym1 name0123456789876543210) where + suppressUnusedWarnings + = snd + (((,) + Let0123456789876543210Scrutinee_0123456789876543210Sym1KindInference) + ()) + data Let0123456789876543210Scrutinee_0123456789876543210Sym1 name0123456789876543210 name'0123456789876543210 + where + Let0123456789876543210Scrutinee_0123456789876543210Sym1KindInference :: forall name0123456789876543210 name'0123456789876543210 - u0123456789876543210 - attrs0123456789876543210 - arg. SameKind (Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym3 name0123456789876543210 name'0123456789876543210 u0123456789876543210) arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym4 name0123456789876543210 name'0123456789876543210 u0123456789876543210 arg) => - Let0123456789876543210Scrutinee_0123456789876543210Sym3 name0123456789876543210 name'0123456789876543210 u0123456789876543210 attrs0123456789876543210 - type instance Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym3 u0123456789876543210 name'0123456789876543210 name0123456789876543210) attrs0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210Sym4 u0123456789876543210 name'0123456789876543210 name0123456789876543210 attrs0123456789876543210 - instance SuppressUnusedWarnings (Let0123456789876543210Scrutinee_0123456789876543210Sym2 name'0123456789876543210 name0123456789876543210) where + arg. SameKind (Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym1 name0123456789876543210) arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym2 name0123456789876543210 arg) => + Let0123456789876543210Scrutinee_0123456789876543210Sym1 name0123456789876543210 name'0123456789876543210 + type instance Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym1 name0123456789876543210) name'0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210Sym2 name0123456789876543210 name'0123456789876543210 + instance SuppressUnusedWarnings (Let0123456789876543210Scrutinee_0123456789876543210Sym2 name0123456789876543210 name'0123456789876543210) where suppressUnusedWarnings = snd (((,) @@ -336,39 +344,37 @@ GradingClient/Database.hs:(0,0)-(0,0): Splicing declarations u0123456789876543210 arg. SameKind (Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym2 name0123456789876543210 name'0123456789876543210) arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym3 name0123456789876543210 name'0123456789876543210 arg) => Let0123456789876543210Scrutinee_0123456789876543210Sym2 name0123456789876543210 name'0123456789876543210 u0123456789876543210 - type instance Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym2 name'0123456789876543210 name0123456789876543210) u0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210Sym3 name'0123456789876543210 name0123456789876543210 u0123456789876543210 - instance SuppressUnusedWarnings (Let0123456789876543210Scrutinee_0123456789876543210Sym1 name0123456789876543210) where + type instance Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym2 name0123456789876543210 name'0123456789876543210) u0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210Sym3 name0123456789876543210 name'0123456789876543210 u0123456789876543210 + instance SuppressUnusedWarnings (Let0123456789876543210Scrutinee_0123456789876543210Sym3 name0123456789876543210 name'0123456789876543210 u0123456789876543210) where suppressUnusedWarnings = snd (((,) - Let0123456789876543210Scrutinee_0123456789876543210Sym1KindInference) + Let0123456789876543210Scrutinee_0123456789876543210Sym3KindInference) ()) - data Let0123456789876543210Scrutinee_0123456789876543210Sym1 name0123456789876543210 name'0123456789876543210 + data Let0123456789876543210Scrutinee_0123456789876543210Sym3 name0123456789876543210 name'0123456789876543210 u0123456789876543210 attrs0123456789876543210 where - Let0123456789876543210Scrutinee_0123456789876543210Sym1KindInference :: forall name0123456789876543210 + Let0123456789876543210Scrutinee_0123456789876543210Sym3KindInference :: forall name0123456789876543210 name'0123456789876543210 - arg. SameKind (Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym1 name0123456789876543210) arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym2 name0123456789876543210 arg) => - Let0123456789876543210Scrutinee_0123456789876543210Sym1 name0123456789876543210 name'0123456789876543210 - type instance Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym1 name0123456789876543210) name'0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210Sym2 name0123456789876543210 name'0123456789876543210 - instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - (((,) - Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference) - ()) - data Let0123456789876543210Scrutinee_0123456789876543210Sym0 name0123456789876543210 - where - Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference :: forall name0123456789876543210 - arg. SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) => - Let0123456789876543210Scrutinee_0123456789876543210Sym0 name0123456789876543210 - type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 name0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210Sym1 name0123456789876543210 + u0123456789876543210 + attrs0123456789876543210 + arg. SameKind (Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym3 name0123456789876543210 name'0123456789876543210 u0123456789876543210) arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym4 name0123456789876543210 name'0123456789876543210 u0123456789876543210 arg) => + Let0123456789876543210Scrutinee_0123456789876543210Sym3 name0123456789876543210 name'0123456789876543210 u0123456789876543210 attrs0123456789876543210 + type instance Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym3 name0123456789876543210 name'0123456789876543210 u0123456789876543210) attrs0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210Sym4 name0123456789876543210 name'0123456789876543210 u0123456789876543210 attrs0123456789876543210 + type Let0123456789876543210Scrutinee_0123456789876543210Sym4 name0123456789876543210 name'0123456789876543210 u0123456789876543210 attrs0123456789876543210 = + Let0123456789876543210Scrutinee_0123456789876543210 name0123456789876543210 name'0123456789876543210 u0123456789876543210 attrs0123456789876543210 type family Let0123456789876543210Scrutinee_0123456789876543210 name name' u attrs where Let0123456789876543210Scrutinee_0123456789876543210 name name' u attrs = Apply (Apply (==@#@$) name) name' type family Case_0123456789876543210 name name' u attrs t where Case_0123456789876543210 name name' u attrs 'True = u Case_0123456789876543210 name name' u attrs 'False = Apply (Apply LookupSym0 name) (Apply SchSym0 attrs) - type LookupSym2 (a0123456789876543210 :: [AChar]) (a0123456789876543210 :: Schema) = - Lookup a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings LookupSym0 where + suppressUnusedWarnings = snd (((,) LookupSym0KindInference) ()) + data LookupSym0 :: (~>) [AChar] ((~>) Schema U) + where + LookupSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply LookupSym0 arg) (LookupSym1 arg) => + LookupSym0 a0123456789876543210 + type instance Apply LookupSym0 a0123456789876543210 = LookupSym1 a0123456789876543210 instance SuppressUnusedWarnings (LookupSym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) LookupSym1KindInference) ()) data LookupSym1 (a0123456789876543210 :: [AChar]) :: (~>) Schema U @@ -378,16 +384,16 @@ GradingClient/Database.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (LookupSym1 a0123456789876543210) arg) (LookupSym2 a0123456789876543210 arg) => LookupSym1 a0123456789876543210 a0123456789876543210 type instance Apply (LookupSym1 a0123456789876543210) a0123456789876543210 = LookupSym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings LookupSym0 where - suppressUnusedWarnings = snd (((,) LookupSym0KindInference) ()) - data LookupSym0 :: (~>) [AChar] ((~>) Schema U) + type LookupSym2 (a0123456789876543210 :: [AChar]) (a0123456789876543210 :: Schema) = + Lookup a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings OccursSym0 where + suppressUnusedWarnings = snd (((,) OccursSym0KindInference) ()) + data OccursSym0 :: (~>) [AChar] ((~>) Schema Bool) where - LookupSym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply LookupSym0 arg) (LookupSym1 arg) => - LookupSym0 a0123456789876543210 - type instance Apply LookupSym0 a0123456789876543210 = LookupSym1 a0123456789876543210 - type OccursSym2 (a0123456789876543210 :: [AChar]) (a0123456789876543210 :: Schema) = - Occurs a0123456789876543210 a0123456789876543210 + OccursSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply OccursSym0 arg) (OccursSym1 arg) => + OccursSym0 a0123456789876543210 + type instance Apply OccursSym0 a0123456789876543210 = OccursSym1 a0123456789876543210 instance SuppressUnusedWarnings (OccursSym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) OccursSym1KindInference) ()) data OccursSym1 (a0123456789876543210 :: [AChar]) :: (~>) Schema Bool @@ -397,16 +403,16 @@ GradingClient/Database.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (OccursSym1 a0123456789876543210) arg) (OccursSym2 a0123456789876543210 arg) => OccursSym1 a0123456789876543210 a0123456789876543210 type instance Apply (OccursSym1 a0123456789876543210) a0123456789876543210 = OccursSym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings OccursSym0 where - suppressUnusedWarnings = snd (((,) OccursSym0KindInference) ()) - data OccursSym0 :: (~>) [AChar] ((~>) Schema Bool) + type OccursSym2 (a0123456789876543210 :: [AChar]) (a0123456789876543210 :: Schema) = + Occurs a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings DisjointSym0 where + suppressUnusedWarnings = snd (((,) DisjointSym0KindInference) ()) + data DisjointSym0 :: (~>) Schema ((~>) Schema Bool) where - OccursSym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply OccursSym0 arg) (OccursSym1 arg) => - OccursSym0 a0123456789876543210 - type instance Apply OccursSym0 a0123456789876543210 = OccursSym1 a0123456789876543210 - type DisjointSym2 (a0123456789876543210 :: Schema) (a0123456789876543210 :: Schema) = - Disjoint a0123456789876543210 a0123456789876543210 + DisjointSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply DisjointSym0 arg) (DisjointSym1 arg) => + DisjointSym0 a0123456789876543210 + type instance Apply DisjointSym0 a0123456789876543210 = DisjointSym1 a0123456789876543210 instance SuppressUnusedWarnings (DisjointSym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) DisjointSym1KindInference) ()) data DisjointSym1 (a0123456789876543210 :: Schema) :: (~>) Schema Bool @@ -416,16 +422,16 @@ GradingClient/Database.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (DisjointSym1 a0123456789876543210) arg) (DisjointSym2 a0123456789876543210 arg) => DisjointSym1 a0123456789876543210 a0123456789876543210 type instance Apply (DisjointSym1 a0123456789876543210) a0123456789876543210 = DisjointSym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings DisjointSym0 where - suppressUnusedWarnings = snd (((,) DisjointSym0KindInference) ()) - data DisjointSym0 :: (~>) Schema ((~>) Schema Bool) + type DisjointSym2 (a0123456789876543210 :: Schema) (a0123456789876543210 :: Schema) = + Disjoint a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings AttrNotInSym0 where + suppressUnusedWarnings = snd (((,) AttrNotInSym0KindInference) ()) + data AttrNotInSym0 :: (~>) Attribute ((~>) Schema Bool) where - DisjointSym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply DisjointSym0 arg) (DisjointSym1 arg) => - DisjointSym0 a0123456789876543210 - type instance Apply DisjointSym0 a0123456789876543210 = DisjointSym1 a0123456789876543210 - type AttrNotInSym2 (a0123456789876543210 :: Attribute) (a0123456789876543210 :: Schema) = - AttrNotIn a0123456789876543210 a0123456789876543210 + AttrNotInSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply AttrNotInSym0 arg) (AttrNotInSym1 arg) => + AttrNotInSym0 a0123456789876543210 + type instance Apply AttrNotInSym0 a0123456789876543210 = AttrNotInSym1 a0123456789876543210 instance SuppressUnusedWarnings (AttrNotInSym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) AttrNotInSym1KindInference) ()) data AttrNotInSym1 (a0123456789876543210 :: Attribute) :: (~>) Schema Bool @@ -435,16 +441,16 @@ GradingClient/Database.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (AttrNotInSym1 a0123456789876543210) arg) (AttrNotInSym2 a0123456789876543210 arg) => AttrNotInSym1 a0123456789876543210 a0123456789876543210 type instance Apply (AttrNotInSym1 a0123456789876543210) a0123456789876543210 = AttrNotInSym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings AttrNotInSym0 where - suppressUnusedWarnings = snd (((,) AttrNotInSym0KindInference) ()) - data AttrNotInSym0 :: (~>) Attribute ((~>) Schema Bool) + type AttrNotInSym2 (a0123456789876543210 :: Attribute) (a0123456789876543210 :: Schema) = + AttrNotIn a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings AppendSym0 where + suppressUnusedWarnings = snd (((,) AppendSym0KindInference) ()) + data AppendSym0 :: (~>) Schema ((~>) Schema Schema) where - AttrNotInSym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply AttrNotInSym0 arg) (AttrNotInSym1 arg) => - AttrNotInSym0 a0123456789876543210 - type instance Apply AttrNotInSym0 a0123456789876543210 = AttrNotInSym1 a0123456789876543210 - type AppendSym2 (a0123456789876543210 :: Schema) (a0123456789876543210 :: Schema) = - Append a0123456789876543210 a0123456789876543210 + AppendSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply AppendSym0 arg) (AppendSym1 arg) => + AppendSym0 a0123456789876543210 + type instance Apply AppendSym0 a0123456789876543210 = AppendSym1 a0123456789876543210 instance SuppressUnusedWarnings (AppendSym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) AppendSym1KindInference) ()) data AppendSym1 (a0123456789876543210 :: Schema) :: (~>) Schema Schema @@ -454,14 +460,8 @@ GradingClient/Database.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (AppendSym1 a0123456789876543210) arg) (AppendSym2 a0123456789876543210 arg) => AppendSym1 a0123456789876543210 a0123456789876543210 type instance Apply (AppendSym1 a0123456789876543210) a0123456789876543210 = AppendSym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings AppendSym0 where - suppressUnusedWarnings = snd (((,) AppendSym0KindInference) ()) - data AppendSym0 :: (~>) Schema ((~>) Schema Schema) - where - AppendSym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply AppendSym0 arg) (AppendSym1 arg) => - AppendSym0 a0123456789876543210 - type instance Apply AppendSym0 a0123456789876543210 = AppendSym1 a0123456789876543210 + type AppendSym2 (a0123456789876543210 :: Schema) (a0123456789876543210 :: Schema) = + Append a0123456789876543210 a0123456789876543210 type family Lookup (a :: [AChar]) (a :: Schema) :: U where Lookup _ (Sch '[]) = UndefinedSym0 Lookup name (Sch ('(:) (Attr name' u) attrs)) = Case_0123456789876543210 name name' u attrs (Let0123456789876543210Scrutinee_0123456789876543210Sym4 name name' u attrs) @@ -481,19 +481,15 @@ GradingClient/Database.hs:(0,0)-(0,0): Splicing declarations ShowsPrec_0123456789876543210 _ STRING a_0123456789876543210 = Apply (Apply ShowStringSym0 "STRING") a_0123456789876543210 ShowsPrec_0123456789876543210 _ NAT a_0123456789876543210 = Apply (Apply ShowStringSym0 "NAT") a_0123456789876543210 ShowsPrec_0123456789876543210 p_0123456789876543210 (VEC arg_0123456789876543210 arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "VEC ")) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210)) (Apply (Apply (.@#@$) ShowSpaceSym0) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210))))) a_0123456789876543210 - type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: U) (a0123456789876543210 :: Symbol) = - ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where suppressUnusedWarnings - = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) - data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: U) :: (~>) Symbol Symbol + = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) + data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Types.Nat ((~>) U ((~>) Symbol Symbol)) where - ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 - a0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => - ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 - type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 + ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => + ShowsPrec_0123456789876543210Sym0 a0123456789876543210 + type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ()) @@ -504,15 +500,19 @@ GradingClient/Database.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) => ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where + instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where suppressUnusedWarnings - = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) - data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Types.Nat ((~>) U ((~>) Symbol Symbol)) + = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) + data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: U) :: (~>) Symbol Symbol where - ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => - ShowsPrec_0123456789876543210Sym0 a0123456789876543210 - type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 + ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 + a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => + ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: U) (a0123456789876543210 :: Symbol) = + ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance PShow U where type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: AChar) (a :: Symbol) :: Symbol where @@ -542,19 +542,15 @@ GradingClient/Database.hs:(0,0)-(0,0): Splicing declarations ShowsPrec_0123456789876543210 _ CX a_0123456789876543210 = Apply (Apply ShowStringSym0 "CX") a_0123456789876543210 ShowsPrec_0123456789876543210 _ CY a_0123456789876543210 = Apply (Apply ShowStringSym0 "CY") a_0123456789876543210 ShowsPrec_0123456789876543210 _ CZ a_0123456789876543210 = Apply (Apply ShowStringSym0 "CZ") a_0123456789876543210 - type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: AChar) (a0123456789876543210 :: Symbol) = - ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where suppressUnusedWarnings - = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) - data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: AChar) :: (~>) Symbol Symbol + = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) + data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Types.Nat ((~>) AChar ((~>) Symbol Symbol)) where - ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 - a0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => - ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 - type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 + ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => + ShowsPrec_0123456789876543210Sym0 a0123456789876543210 + type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ()) @@ -565,15 +561,19 @@ GradingClient/Database.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) => ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where + instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where suppressUnusedWarnings - = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) - data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Types.Nat ((~>) AChar ((~>) Symbol Symbol)) + = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) + data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: AChar) :: (~>) Symbol Symbol where - ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => - ShowsPrec_0123456789876543210Sym0 a0123456789876543210 - type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 + ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 + a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => + ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: AChar) (a0123456789876543210 :: Symbol) = + ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance PShow AChar where type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a type family Equals_0123456789876543210 (a :: U) (b :: U) :: Bool where diff --git a/tests/compile-and-dump/InsertionSort/InsertionSortImp.golden b/tests/compile-and-dump/InsertionSort/InsertionSortImp.golden index 4d323117..9390eff3 100644 --- a/tests/compile-and-dump/InsertionSort/InsertionSortImp.golden +++ b/tests/compile-and-dump/InsertionSort/InsertionSortImp.golden @@ -3,8 +3,6 @@ InsertionSort/InsertionSortImp.hs:(0,0)-(0,0): Splicing declarations ======> data Nat = Zero | Succ Nat type ZeroSym0 = Zero - type SuccSym1 (t0123456789876543210 :: Nat) = - Succ t0123456789876543210 instance SuppressUnusedWarnings SuccSym0 where suppressUnusedWarnings = snd (((,) SuccSym0KindInference) ()) data SuccSym0 :: (~>) Nat Nat @@ -13,6 +11,8 @@ InsertionSort/InsertionSortImp.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply SuccSym0 arg) (SuccSym1 arg) => SuccSym0 t0123456789876543210 type instance Apply SuccSym0 t0123456789876543210 = SuccSym1 t0123456789876543210 + type SuccSym1 (t0123456789876543210 :: Nat) = + Succ t0123456789876543210 data SNat :: Nat -> Type where SZero :: SNat (Zero :: Nat) @@ -57,22 +57,18 @@ InsertionSort/InsertionSortImp.hs:(0,0)-(0,0): Splicing declarations insertionSort :: [Nat] -> [Nat] insertionSort [] = [] insertionSort (h : t) = (insert h) (insertionSort t) - type Let0123456789876543210Scrutinee_0123456789876543210Sym3 n0123456789876543210 h0123456789876543210 t0123456789876543210 = - Let0123456789876543210Scrutinee_0123456789876543210 n0123456789876543210 h0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Let0123456789876543210Scrutinee_0123456789876543210Sym2 h0123456789876543210 n0123456789876543210) where + instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) - Let0123456789876543210Scrutinee_0123456789876543210Sym2KindInference) + Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference) ()) - data Let0123456789876543210Scrutinee_0123456789876543210Sym2 n0123456789876543210 h0123456789876543210 t0123456789876543210 + data Let0123456789876543210Scrutinee_0123456789876543210Sym0 n0123456789876543210 where - Let0123456789876543210Scrutinee_0123456789876543210Sym2KindInference :: forall n0123456789876543210 - h0123456789876543210 - t0123456789876543210 - arg. SameKind (Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym2 n0123456789876543210 h0123456789876543210) arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym3 n0123456789876543210 h0123456789876543210 arg) => - Let0123456789876543210Scrutinee_0123456789876543210Sym2 n0123456789876543210 h0123456789876543210 t0123456789876543210 - type instance Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym2 h0123456789876543210 n0123456789876543210) t0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210Sym3 h0123456789876543210 n0123456789876543210 t0123456789876543210 + Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference :: forall n0123456789876543210 + arg. SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) => + Let0123456789876543210Scrutinee_0123456789876543210Sym0 n0123456789876543210 + type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 n0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210Sym1 n0123456789876543210 instance SuppressUnusedWarnings (Let0123456789876543210Scrutinee_0123456789876543210Sym1 n0123456789876543210) where suppressUnusedWarnings = snd @@ -86,25 +82,27 @@ InsertionSort/InsertionSortImp.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym1 n0123456789876543210) arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym2 n0123456789876543210 arg) => Let0123456789876543210Scrutinee_0123456789876543210Sym1 n0123456789876543210 h0123456789876543210 type instance Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym1 n0123456789876543210) h0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210Sym2 n0123456789876543210 h0123456789876543210 - instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where + instance SuppressUnusedWarnings (Let0123456789876543210Scrutinee_0123456789876543210Sym2 n0123456789876543210 h0123456789876543210) where suppressUnusedWarnings = snd (((,) - Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference) + Let0123456789876543210Scrutinee_0123456789876543210Sym2KindInference) ()) - data Let0123456789876543210Scrutinee_0123456789876543210Sym0 n0123456789876543210 + data Let0123456789876543210Scrutinee_0123456789876543210Sym2 n0123456789876543210 h0123456789876543210 t0123456789876543210 where - Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference :: forall n0123456789876543210 - arg. SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) => - Let0123456789876543210Scrutinee_0123456789876543210Sym0 n0123456789876543210 - type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 n0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210Sym1 n0123456789876543210 + Let0123456789876543210Scrutinee_0123456789876543210Sym2KindInference :: forall n0123456789876543210 + h0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym2 n0123456789876543210 h0123456789876543210) arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym3 n0123456789876543210 h0123456789876543210 arg) => + Let0123456789876543210Scrutinee_0123456789876543210Sym2 n0123456789876543210 h0123456789876543210 t0123456789876543210 + type instance Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym2 n0123456789876543210 h0123456789876543210) t0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210Sym3 n0123456789876543210 h0123456789876543210 t0123456789876543210 + type Let0123456789876543210Scrutinee_0123456789876543210Sym3 n0123456789876543210 h0123456789876543210 t0123456789876543210 = + Let0123456789876543210Scrutinee_0123456789876543210 n0123456789876543210 h0123456789876543210 t0123456789876543210 type family Let0123456789876543210Scrutinee_0123456789876543210 n h t where Let0123456789876543210Scrutinee_0123456789876543210 n h t = Apply (Apply LeqSym0 n) h type family Case_0123456789876543210 n h t t where Case_0123456789876543210 n h t 'True = Apply (Apply (:@#@$) n) (Apply (Apply (:@#@$) h) t) Case_0123456789876543210 n h t 'False = Apply (Apply (:@#@$) h) (Apply (Apply InsertSym0 n) t) - type InsertionSortSym1 (a0123456789876543210 :: [Nat]) = - InsertionSort a0123456789876543210 instance SuppressUnusedWarnings InsertionSortSym0 where suppressUnusedWarnings = snd (((,) InsertionSortSym0KindInference) ()) @@ -114,8 +112,16 @@ InsertionSort/InsertionSortImp.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply InsertionSortSym0 arg) (InsertionSortSym1 arg) => InsertionSortSym0 a0123456789876543210 type instance Apply InsertionSortSym0 a0123456789876543210 = InsertionSortSym1 a0123456789876543210 - type InsertSym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: [Nat]) = - Insert a0123456789876543210 a0123456789876543210 + type InsertionSortSym1 (a0123456789876543210 :: [Nat]) = + InsertionSort a0123456789876543210 + instance SuppressUnusedWarnings InsertSym0 where + suppressUnusedWarnings = snd (((,) InsertSym0KindInference) ()) + data InsertSym0 :: (~>) Nat ((~>) [Nat] [Nat]) + where + InsertSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply InsertSym0 arg) (InsertSym1 arg) => + InsertSym0 a0123456789876543210 + type instance Apply InsertSym0 a0123456789876543210 = InsertSym1 a0123456789876543210 instance SuppressUnusedWarnings (InsertSym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) InsertSym1KindInference) ()) data InsertSym1 (a0123456789876543210 :: Nat) :: (~>) [Nat] [Nat] @@ -125,16 +131,16 @@ InsertionSort/InsertionSortImp.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (InsertSym1 a0123456789876543210) arg) (InsertSym2 a0123456789876543210 arg) => InsertSym1 a0123456789876543210 a0123456789876543210 type instance Apply (InsertSym1 a0123456789876543210) a0123456789876543210 = InsertSym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings InsertSym0 where - suppressUnusedWarnings = snd (((,) InsertSym0KindInference) ()) - data InsertSym0 :: (~>) Nat ((~>) [Nat] [Nat]) + type InsertSym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: [Nat]) = + Insert a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings LeqSym0 where + suppressUnusedWarnings = snd (((,) LeqSym0KindInference) ()) + data LeqSym0 :: (~>) Nat ((~>) Nat Bool) where - InsertSym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply InsertSym0 arg) (InsertSym1 arg) => - InsertSym0 a0123456789876543210 - type instance Apply InsertSym0 a0123456789876543210 = InsertSym1 a0123456789876543210 - type LeqSym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) = - Leq a0123456789876543210 a0123456789876543210 + LeqSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply LeqSym0 arg) (LeqSym1 arg) => + LeqSym0 a0123456789876543210 + type instance Apply LeqSym0 a0123456789876543210 = LeqSym1 a0123456789876543210 instance SuppressUnusedWarnings (LeqSym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) LeqSym1KindInference) ()) data LeqSym1 (a0123456789876543210 :: Nat) :: (~>) Nat Bool @@ -144,14 +150,8 @@ InsertionSort/InsertionSortImp.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (LeqSym1 a0123456789876543210) arg) (LeqSym2 a0123456789876543210 arg) => LeqSym1 a0123456789876543210 a0123456789876543210 type instance Apply (LeqSym1 a0123456789876543210) a0123456789876543210 = LeqSym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings LeqSym0 where - suppressUnusedWarnings = snd (((,) LeqSym0KindInference) ()) - data LeqSym0 :: (~>) Nat ((~>) Nat Bool) - where - LeqSym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply LeqSym0 arg) (LeqSym1 arg) => - LeqSym0 a0123456789876543210 - type instance Apply LeqSym0 a0123456789876543210 = LeqSym1 a0123456789876543210 + type LeqSym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) = + Leq a0123456789876543210 a0123456789876543210 type family InsertionSort (a :: [Nat]) :: [Nat] where InsertionSort '[] = '[] InsertionSort ('(:) h t) = Apply (Apply InsertSym0 h) (Apply InsertionSortSym0 t) diff --git a/tests/compile-and-dump/Promote/Constructors.golden b/tests/compile-and-dump/Promote/Constructors.golden index 99895900..28a5ad23 100644 --- a/tests/compile-and-dump/Promote/Constructors.golden +++ b/tests/compile-and-dump/Promote/Constructors.golden @@ -6,8 +6,14 @@ Promote/Constructors.hs:(0,0)-(0,0): Splicing declarations data Foo = Foo | Foo :+ Foo data Bar = Bar Bar Bar Bar Bar Foo type FooSym0 = Foo - type (:+@#@$$$) (t0123456789876543210 :: Foo) (t0123456789876543210 :: Foo) = - (:+) t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (:+@#@$) where + suppressUnusedWarnings = snd (((,) (::+@#@$###)) ()) + data (:+@#@$) :: (~>) Foo ((~>) Foo Foo) + where + (::+@#@$###) :: forall t0123456789876543210 + arg. SameKind (Apply (:+@#@$) arg) ((:+@#@$$) arg) => + (:+@#@$) t0123456789876543210 + type instance Apply (:+@#@$) t0123456789876543210 = (:+@#@$$) t0123456789876543210 instance SuppressUnusedWarnings ((:+@#@$$) t0123456789876543210) where suppressUnusedWarnings = snd (((,) (::+@#@$$###)) ()) data (:+@#@$$) (t0123456789876543210 :: Foo) :: (~>) Foo Foo @@ -17,28 +23,35 @@ Promote/Constructors.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply ((:+@#@$$) t0123456789876543210) arg) ((:+@#@$$$) t0123456789876543210 arg) => (:+@#@$$) t0123456789876543210 t0123456789876543210 type instance Apply ((:+@#@$$) t0123456789876543210) t0123456789876543210 = (:+@#@$$$) t0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (:+@#@$) where - suppressUnusedWarnings = snd (((,) (::+@#@$###)) ()) - data (:+@#@$) :: (~>) Foo ((~>) Foo Foo) + type (:+@#@$$$) (t0123456789876543210 :: Foo) (t0123456789876543210 :: Foo) = + (:+) t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings BarSym0 where + suppressUnusedWarnings = snd (((,) BarSym0KindInference) ()) + data BarSym0 :: (~>) Bar ((~>) Bar ((~>) Bar ((~>) Bar ((~>) Foo Bar)))) where - (::+@#@$###) :: forall t0123456789876543210 - arg. SameKind (Apply (:+@#@$) arg) ((:+@#@$$) arg) => - (:+@#@$) t0123456789876543210 - type instance Apply (:+@#@$) t0123456789876543210 = (:+@#@$$) t0123456789876543210 - type BarSym5 (t0123456789876543210 :: Bar) (t0123456789876543210 :: Bar) (t0123456789876543210 :: Bar) (t0123456789876543210 :: Bar) (t0123456789876543210 :: Foo) = - Bar t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (BarSym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210) where - suppressUnusedWarnings = snd (((,) BarSym4KindInference) ()) - data BarSym4 (t0123456789876543210 :: Bar) (t0123456789876543210 :: Bar) (t0123456789876543210 :: Bar) (t0123456789876543210 :: Bar) :: (~>) Foo Bar + BarSym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply BarSym0 arg) (BarSym1 arg) => + BarSym0 t0123456789876543210 + type instance Apply BarSym0 t0123456789876543210 = BarSym1 t0123456789876543210 + instance SuppressUnusedWarnings (BarSym1 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) BarSym1KindInference) ()) + data BarSym1 (t0123456789876543210 :: Bar) :: (~>) Bar ((~>) Bar ((~>) Bar ((~>) Foo Bar))) where - BarSym4KindInference :: forall t0123456789876543210 - t0123456789876543210 + BarSym1KindInference :: forall t0123456789876543210 t0123456789876543210 + arg. SameKind (Apply (BarSym1 t0123456789876543210) arg) (BarSym2 t0123456789876543210 arg) => + BarSym1 t0123456789876543210 t0123456789876543210 + type instance Apply (BarSym1 t0123456789876543210) t0123456789876543210 = BarSym2 t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (BarSym2 t0123456789876543210 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) BarSym2KindInference) ()) + data BarSym2 (t0123456789876543210 :: Bar) (t0123456789876543210 :: Bar) :: (~>) Bar ((~>) Bar ((~>) Foo Bar)) + where + BarSym2KindInference :: forall t0123456789876543210 t0123456789876543210 t0123456789876543210 - arg. SameKind (Apply (BarSym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210) arg) (BarSym5 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 arg) => - BarSym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 - type instance Apply (BarSym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210) t0123456789876543210 = BarSym5 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 + arg. SameKind (Apply (BarSym2 t0123456789876543210 t0123456789876543210) arg) (BarSym3 t0123456789876543210 t0123456789876543210 arg) => + BarSym2 t0123456789876543210 t0123456789876543210 t0123456789876543210 + type instance Apply (BarSym2 t0123456789876543210 t0123456789876543210) t0123456789876543210 = BarSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (BarSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) where suppressUnusedWarnings = snd (((,) BarSym3KindInference) ()) data BarSym3 (t0123456789876543210 :: Bar) (t0123456789876543210 :: Bar) (t0123456789876543210 :: Bar) :: (~>) Bar ((~>) Foo Bar) @@ -50,30 +63,17 @@ Promote/Constructors.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (BarSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) arg) (BarSym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 arg) => BarSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 type instance Apply (BarSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) t0123456789876543210 = BarSym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (BarSym2 t0123456789876543210 t0123456789876543210) where - suppressUnusedWarnings = snd (((,) BarSym2KindInference) ()) - data BarSym2 (t0123456789876543210 :: Bar) (t0123456789876543210 :: Bar) :: (~>) Bar ((~>) Bar ((~>) Foo Bar)) + instance SuppressUnusedWarnings (BarSym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) BarSym4KindInference) ()) + data BarSym4 (t0123456789876543210 :: Bar) (t0123456789876543210 :: Bar) (t0123456789876543210 :: Bar) (t0123456789876543210 :: Bar) :: (~>) Foo Bar where - BarSym2KindInference :: forall t0123456789876543210 + BarSym4KindInference :: forall t0123456789876543210 t0123456789876543210 t0123456789876543210 - arg. SameKind (Apply (BarSym2 t0123456789876543210 t0123456789876543210) arg) (BarSym3 t0123456789876543210 t0123456789876543210 arg) => - BarSym2 t0123456789876543210 t0123456789876543210 t0123456789876543210 - type instance Apply (BarSym2 t0123456789876543210 t0123456789876543210) t0123456789876543210 = BarSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (BarSym1 t0123456789876543210) where - suppressUnusedWarnings = snd (((,) BarSym1KindInference) ()) - data BarSym1 (t0123456789876543210 :: Bar) :: (~>) Bar ((~>) Bar ((~>) Bar ((~>) Foo Bar))) - where - BarSym1KindInference :: forall t0123456789876543210 t0123456789876543210 - arg. SameKind (Apply (BarSym1 t0123456789876543210) arg) (BarSym2 t0123456789876543210 arg) => - BarSym1 t0123456789876543210 t0123456789876543210 - type instance Apply (BarSym1 t0123456789876543210) t0123456789876543210 = BarSym2 t0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings BarSym0 where - suppressUnusedWarnings = snd (((,) BarSym0KindInference) ()) - data BarSym0 :: (~>) Bar ((~>) Bar ((~>) Bar ((~>) Bar ((~>) Foo Bar)))) - where - BarSym0KindInference :: forall t0123456789876543210 - arg. SameKind (Apply BarSym0 arg) (BarSym1 arg) => - BarSym0 t0123456789876543210 - type instance Apply BarSym0 t0123456789876543210 = BarSym1 t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (BarSym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210) arg) (BarSym5 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 arg) => + BarSym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 + type instance Apply (BarSym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210) t0123456789876543210 = BarSym5 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 + type BarSym5 (t0123456789876543210 :: Bar) (t0123456789876543210 :: Bar) (t0123456789876543210 :: Bar) (t0123456789876543210 :: Bar) (t0123456789876543210 :: Foo) = + Bar t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 diff --git a/tests/compile-and-dump/Promote/GenDefunSymbols.golden b/tests/compile-and-dump/Promote/GenDefunSymbols.golden index d9bdfb13..a022ecd9 100644 --- a/tests/compile-and-dump/Promote/GenDefunSymbols.golden +++ b/tests/compile-and-dump/Promote/GenDefunSymbols.golden @@ -1,17 +1,6 @@ Promote/GenDefunSymbols.hs:0:0:: Splicing declarations genDefunSymbols [''LiftMaybe, ''NatT, ''(:+)] ======> - type LiftMaybeSym2 (f0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) (x0123456789876543210 :: Maybe a0123456789876543210) = - LiftMaybe f0123456789876543210 x0123456789876543210 - instance SuppressUnusedWarnings (LiftMaybeSym1 f0123456789876543210) where - suppressUnusedWarnings = snd (((,) LiftMaybeSym1KindInference) ()) - data LiftMaybeSym1 (f0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) :: (~>) (Maybe a0123456789876543210) (Maybe b0123456789876543210) - where - LiftMaybeSym1KindInference :: forall f0123456789876543210 - x0123456789876543210 - arg. Data.Singletons.Internal.SameKind (Apply (LiftMaybeSym1 f0123456789876543210) arg) (LiftMaybeSym2 f0123456789876543210 arg) => - LiftMaybeSym1 f0123456789876543210 x0123456789876543210 - type instance Apply (LiftMaybeSym1 f0123456789876543210) x0123456789876543210 = LiftMaybeSym2 f0123456789876543210 x0123456789876543210 instance SuppressUnusedWarnings LiftMaybeSym0 where suppressUnusedWarnings = snd (((,) LiftMaybeSym0KindInference) ()) data LiftMaybeSym0 :: forall a0123456789876543210 @@ -22,9 +11,18 @@ Promote/GenDefunSymbols.hs:0:0:: Splicing declarations arg. Data.Singletons.Internal.SameKind (Apply LiftMaybeSym0 arg) (LiftMaybeSym1 arg) => LiftMaybeSym0 f0123456789876543210 type instance Apply LiftMaybeSym0 f0123456789876543210 = LiftMaybeSym1 f0123456789876543210 + instance SuppressUnusedWarnings (LiftMaybeSym1 f0123456789876543210) where + suppressUnusedWarnings = snd (((,) LiftMaybeSym1KindInference) ()) + data LiftMaybeSym1 (f0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) :: (~>) (Maybe a0123456789876543210) (Maybe b0123456789876543210) + where + LiftMaybeSym1KindInference :: forall f0123456789876543210 + x0123456789876543210 + arg. Data.Singletons.Internal.SameKind (Apply (LiftMaybeSym1 f0123456789876543210) arg) (LiftMaybeSym2 f0123456789876543210 arg) => + LiftMaybeSym1 f0123456789876543210 x0123456789876543210 + type instance Apply (LiftMaybeSym1 f0123456789876543210) x0123456789876543210 = LiftMaybeSym2 f0123456789876543210 x0123456789876543210 + type LiftMaybeSym2 (f0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) (x0123456789876543210 :: Maybe a0123456789876543210) = + LiftMaybe f0123456789876543210 x0123456789876543210 type ZeroSym0 = 'Zero - type SuccSym1 (t0123456789876543210 :: NatT) = - 'Succ t0123456789876543210 instance SuppressUnusedWarnings SuccSym0 where suppressUnusedWarnings = snd (((,) SuccSym0KindInference) ()) data SuccSym0 :: (~>) NatT NatT @@ -33,8 +31,16 @@ Promote/GenDefunSymbols.hs:0:0:: Splicing declarations arg. Data.Singletons.Internal.SameKind (Apply SuccSym0 arg) (SuccSym1 arg) => SuccSym0 t0123456789876543210 type instance Apply SuccSym0 t0123456789876543210 = SuccSym1 t0123456789876543210 - type (:+@#@$$$) (a0123456789876543210 :: Nat) (b0123456789876543210 :: Nat) = - (:+) a0123456789876543210 b0123456789876543210 + type SuccSym1 (t0123456789876543210 :: NatT) = + 'Succ t0123456789876543210 + instance SuppressUnusedWarnings (:+@#@$) where + suppressUnusedWarnings = snd (((,) (::+@#@$###)) ()) + data (:+@#@$) a0123456789876543210 + where + (::+@#@$###) :: forall a0123456789876543210 + arg. Data.Singletons.Internal.SameKind (Apply (:+@#@$) arg) ((:+@#@$$) arg) => + (:+@#@$) a0123456789876543210 + type instance Apply (:+@#@$) a0123456789876543210 = (:+@#@$$) a0123456789876543210 instance SuppressUnusedWarnings ((:+@#@$$) a0123456789876543210) where suppressUnusedWarnings = snd (((,) (::+@#@$$###)) ()) data (:+@#@$$) (a0123456789876543210 :: Nat) b0123456789876543210 @@ -44,11 +50,5 @@ Promote/GenDefunSymbols.hs:0:0:: Splicing declarations arg. Data.Singletons.Internal.SameKind (Apply ((:+@#@$$) a0123456789876543210) arg) ((:+@#@$$$) a0123456789876543210 arg) => (:+@#@$$) a0123456789876543210 b0123456789876543210 type instance Apply ((:+@#@$$) a0123456789876543210) b0123456789876543210 = (:+@#@$$$) a0123456789876543210 b0123456789876543210 - instance SuppressUnusedWarnings (:+@#@$) where - suppressUnusedWarnings = snd (((,) (::+@#@$###)) ()) - data (:+@#@$) a0123456789876543210 - where - (::+@#@$###) :: forall a0123456789876543210 - arg. Data.Singletons.Internal.SameKind (Apply (:+@#@$) arg) ((:+@#@$$) arg) => - (:+@#@$) a0123456789876543210 - type instance Apply (:+@#@$) a0123456789876543210 = (:+@#@$$) a0123456789876543210 + type (:+@#@$$$) (a0123456789876543210 :: Nat) (b0123456789876543210 :: Nat) = + (:+) a0123456789876543210 b0123456789876543210 diff --git a/tests/compile-and-dump/Promote/Newtypes.golden b/tests/compile-and-dump/Promote/Newtypes.golden index cc197509..88448c38 100644 --- a/tests/compile-and-dump/Promote/Newtypes.golden +++ b/tests/compile-and-dump/Promote/Newtypes.golden @@ -14,8 +14,6 @@ Promote/Newtypes.hs:(0,0)-(0,0): Splicing declarations Equals_0123456789876543210 (_ :: Foo) (_ :: Foo) = FalseSym0 instance PEq Foo where type (==) a b = Equals_0123456789876543210 a b - type UnBarSym1 (a0123456789876543210 :: Bar) = - UnBar a0123456789876543210 instance SuppressUnusedWarnings UnBarSym0 where suppressUnusedWarnings = snd (((,) UnBarSym0KindInference) ()) data UnBarSym0 :: (~>) Bar Nat @@ -24,10 +22,10 @@ Promote/Newtypes.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply UnBarSym0 arg) (UnBarSym1 arg) => UnBarSym0 a0123456789876543210 type instance Apply UnBarSym0 a0123456789876543210 = UnBarSym1 a0123456789876543210 + type UnBarSym1 (a0123456789876543210 :: Bar) = + UnBar a0123456789876543210 type family UnBar (a :: Bar) :: Nat where UnBar (Bar field) = field - type FooSym1 (t0123456789876543210 :: Nat) = - Foo t0123456789876543210 instance SuppressUnusedWarnings FooSym0 where suppressUnusedWarnings = snd (((,) FooSym0KindInference) ()) data FooSym0 :: (~>) Nat Foo @@ -36,8 +34,8 @@ Promote/Newtypes.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) => FooSym0 t0123456789876543210 type instance Apply FooSym0 t0123456789876543210 = FooSym1 t0123456789876543210 - type BarSym1 (t0123456789876543210 :: Nat) = - Bar t0123456789876543210 + type FooSym1 (t0123456789876543210 :: Nat) = + Foo t0123456789876543210 instance SuppressUnusedWarnings BarSym0 where suppressUnusedWarnings = snd (((,) BarSym0KindInference) ()) data BarSym0 :: (~>) Nat Bar @@ -46,3 +44,5 @@ Promote/Newtypes.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply BarSym0 arg) (BarSym1 arg) => BarSym0 t0123456789876543210 type instance Apply BarSym0 t0123456789876543210 = BarSym1 t0123456789876543210 + type BarSym1 (t0123456789876543210 :: Nat) = + Bar t0123456789876543210 diff --git a/tests/compile-and-dump/Promote/Prelude.golden b/tests/compile-and-dump/Promote/Prelude.golden index fc99d45f..e6b306c7 100644 --- a/tests/compile-and-dump/Promote/Prelude.golden +++ b/tests/compile-and-dump/Promote/Prelude.golden @@ -4,8 +4,6 @@ Promote/Prelude.hs:(0,0)-(0,0): Splicing declarations odd 0 = False odd n = not . odd $ n - 1 |] ======> - type OddSym1 (a0123456789876543210 :: Nat) = - Odd a0123456789876543210 instance SuppressUnusedWarnings OddSym0 where suppressUnusedWarnings = snd (((,) OddSym0KindInference) ()) data OddSym0 :: (~>) Nat Bool @@ -14,6 +12,8 @@ Promote/Prelude.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply OddSym0 arg) (OddSym1 arg) => OddSym0 a0123456789876543210 type instance Apply OddSym0 a0123456789876543210 = OddSym1 a0123456789876543210 + type OddSym1 (a0123456789876543210 :: Nat) = + Odd a0123456789876543210 type family Odd (a :: Nat) :: Bool where Odd 0 = FalseSym0 Odd n = Apply (Apply ($@#@$) (Apply (Apply (.@#@$) NotSym0) OddSym0)) (Apply (Apply (-@#@$) n) (FromInteger 1)) diff --git a/tests/compile-and-dump/Promote/T180.golden b/tests/compile-and-dump/Promote/T180.golden index 396f16ac..e53a91ae 100644 --- a/tests/compile-and-dump/Promote/T180.golden +++ b/tests/compile-and-dump/Promote/T180.golden @@ -8,7 +8,6 @@ Promote/T180.hs:(0,0)-(0,0): Splicing declarations data X = X1 {y :: Symbol} | X2 {y :: Symbol} z (X1 x) = x z (X2 x) = x - type ZSym1 a0123456789876543210 = Z a0123456789876543210 instance SuppressUnusedWarnings ZSym0 where suppressUnusedWarnings = snd (((,) ZSym0KindInference) ()) data ZSym0 a0123456789876543210 @@ -17,10 +16,10 @@ Promote/T180.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply ZSym0 arg) (ZSym1 arg) => ZSym0 a0123456789876543210 type instance Apply ZSym0 a0123456789876543210 = ZSym1 a0123456789876543210 + type ZSym1 a0123456789876543210 = Z a0123456789876543210 type family Z a where Z (X1 x) = x Z (X2 x) = x - type YSym1 (a0123456789876543210 :: X) = Y a0123456789876543210 instance SuppressUnusedWarnings YSym0 where suppressUnusedWarnings = snd (((,) YSym0KindInference) ()) data YSym0 :: (~>) X Symbol @@ -29,11 +28,10 @@ Promote/T180.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply YSym0 arg) (YSym1 arg) => YSym0 a0123456789876543210 type instance Apply YSym0 a0123456789876543210 = YSym1 a0123456789876543210 + type YSym1 (a0123456789876543210 :: X) = Y a0123456789876543210 type family Y (a :: X) :: Symbol where Y (X1 field) = field Y (X2 field) = field - type X1Sym1 (t0123456789876543210 :: Symbol) = - X1 t0123456789876543210 instance SuppressUnusedWarnings X1Sym0 where suppressUnusedWarnings = snd (((,) X1Sym0KindInference) ()) data X1Sym0 :: (~>) Symbol X @@ -42,8 +40,8 @@ Promote/T180.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply X1Sym0 arg) (X1Sym1 arg) => X1Sym0 t0123456789876543210 type instance Apply X1Sym0 t0123456789876543210 = X1Sym1 t0123456789876543210 - type X2Sym1 (t0123456789876543210 :: Symbol) = - X2 t0123456789876543210 + type X1Sym1 (t0123456789876543210 :: Symbol) = + X1 t0123456789876543210 instance SuppressUnusedWarnings X2Sym0 where suppressUnusedWarnings = snd (((,) X2Sym0KindInference) ()) data X2Sym0 :: (~>) Symbol X @@ -52,3 +50,5 @@ Promote/T180.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply X2Sym0 arg) (X2Sym1 arg) => X2Sym0 t0123456789876543210 type instance Apply X2Sym0 t0123456789876543210 = X2Sym1 t0123456789876543210 + type X2Sym1 (t0123456789876543210 :: Symbol) = + X2 t0123456789876543210 diff --git a/tests/compile-and-dump/Promote/T361.golden b/tests/compile-and-dump/Promote/T361.golden index 677a3ee7..bb7839f6 100644 --- a/tests/compile-and-dump/Promote/T361.golden +++ b/tests/compile-and-dump/Promote/T361.golden @@ -7,8 +7,6 @@ Promote/T361.hs:(0,0)-(0,0): Splicing declarations ======> f :: Proxy 1 -> Proxy 2 f Proxy = Proxy - type FSym1 (a0123456789876543210 :: Proxy 1) = - F a0123456789876543210 instance SuppressUnusedWarnings FSym0 where suppressUnusedWarnings = snd (((,) FSym0KindInference) ()) data FSym0 :: (~>) (Proxy 1) (Proxy 2) @@ -17,5 +15,7 @@ Promote/T361.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply FSym0 arg) (FSym1 arg) => FSym0 a0123456789876543210 type instance Apply FSym0 a0123456789876543210 = FSym1 a0123456789876543210 + type FSym1 (a0123456789876543210 :: Proxy 1) = + F a0123456789876543210 type family F (a :: Proxy 1) :: Proxy 2 where F 'Proxy = ProxySym0 diff --git a/tests/compile-and-dump/Singletons/AsPattern.golden b/tests/compile-and-dump/Singletons/AsPattern.golden index 30bd49d3..1488a118 100644 --- a/tests/compile-and-dump/Singletons/AsPattern.golden +++ b/tests/compile-and-dump/Singletons/AsPattern.golden @@ -34,18 +34,14 @@ Singletons/AsPattern.hs:(0,0)-(0,0): Splicing declarations foo p@[] = p foo p@[_] = p foo p@(_ : (_ : _)) = p - type BazSym3 (t0123456789876543210 :: Nat) (t0123456789876543210 :: Nat) (t0123456789876543210 :: Nat) = - Baz t0123456789876543210 t0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (BazSym2 t0123456789876543210 t0123456789876543210) where - suppressUnusedWarnings = snd (((,) BazSym2KindInference) ()) - data BazSym2 (t0123456789876543210 :: Nat) (t0123456789876543210 :: Nat) :: (~>) Nat Baz + instance SuppressUnusedWarnings BazSym0 where + suppressUnusedWarnings = snd (((,) BazSym0KindInference) ()) + data BazSym0 :: (~>) Nat ((~>) Nat ((~>) Nat Baz)) where - BazSym2KindInference :: forall t0123456789876543210 - t0123456789876543210 - t0123456789876543210 - arg. SameKind (Apply (BazSym2 t0123456789876543210 t0123456789876543210) arg) (BazSym3 t0123456789876543210 t0123456789876543210 arg) => - BazSym2 t0123456789876543210 t0123456789876543210 t0123456789876543210 - type instance Apply (BazSym2 t0123456789876543210 t0123456789876543210) t0123456789876543210 = BazSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 + BazSym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply BazSym0 arg) (BazSym1 arg) => + BazSym0 t0123456789876543210 + type instance Apply BazSym0 t0123456789876543210 = BazSym1 t0123456789876543210 instance SuppressUnusedWarnings (BazSym1 t0123456789876543210) where suppressUnusedWarnings = snd (((,) BazSym1KindInference) ()) data BazSym1 (t0123456789876543210 :: Nat) :: (~>) Nat ((~>) Nat Baz) @@ -55,19 +51,21 @@ Singletons/AsPattern.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (BazSym1 t0123456789876543210) arg) (BazSym2 t0123456789876543210 arg) => BazSym1 t0123456789876543210 t0123456789876543210 type instance Apply (BazSym1 t0123456789876543210) t0123456789876543210 = BazSym2 t0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings BazSym0 where - suppressUnusedWarnings = snd (((,) BazSym0KindInference) ()) - data BazSym0 :: (~>) Nat ((~>) Nat ((~>) Nat Baz)) + instance SuppressUnusedWarnings (BazSym2 t0123456789876543210 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) BazSym2KindInference) ()) + data BazSym2 (t0123456789876543210 :: Nat) (t0123456789876543210 :: Nat) :: (~>) Nat Baz where - BazSym0KindInference :: forall t0123456789876543210 - arg. SameKind (Apply BazSym0 arg) (BazSym1 arg) => - BazSym0 t0123456789876543210 - type instance Apply BazSym0 t0123456789876543210 = BazSym1 t0123456789876543210 + BazSym2KindInference :: forall t0123456789876543210 + t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (BazSym2 t0123456789876543210 t0123456789876543210) arg) (BazSym3 t0123456789876543210 t0123456789876543210 arg) => + BazSym2 t0123456789876543210 t0123456789876543210 t0123456789876543210 + type instance Apply (BazSym2 t0123456789876543210 t0123456789876543210) t0123456789876543210 = BazSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 + type BazSym3 (t0123456789876543210 :: Nat) (t0123456789876543210 :: Nat) (t0123456789876543210 :: Nat) = + Baz t0123456789876543210 t0123456789876543210 t0123456789876543210 type Let0123456789876543210PSym0 = Let0123456789876543210P type family Let0123456789876543210P where Let0123456789876543210P = '[] - type Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210 = - Let0123456789876543210P wild_01234567898765432100123456789876543210 instance SuppressUnusedWarnings Let0123456789876543210PSym0 where suppressUnusedWarnings = snd (((,) Let0123456789876543210PSym0KindInference) ()) @@ -77,21 +75,19 @@ Singletons/AsPattern.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Let0123456789876543210PSym0 arg) (Let0123456789876543210PSym1 arg) => Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 type instance Apply Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 = Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210 + type Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210 = + Let0123456789876543210P wild_01234567898765432100123456789876543210 type family Let0123456789876543210P wild_0123456789876543210 where Let0123456789876543210P wild_0123456789876543210 = Apply (Apply (:@#@$) wild_0123456789876543210) '[] - type Let0123456789876543210PSym3 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 = - Let0123456789876543210P wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210) where + instance SuppressUnusedWarnings Let0123456789876543210PSym0 where suppressUnusedWarnings - = snd (((,) Let0123456789876543210PSym2KindInference) ()) - data Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 + = snd (((,) Let0123456789876543210PSym0KindInference) ()) + data Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 where - Let0123456789876543210PSym2KindInference :: forall wild_01234567898765432100123456789876543210 - wild_01234567898765432100123456789876543210 - wild_01234567898765432100123456789876543210 - arg. SameKind (Apply (Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210) arg) (Let0123456789876543210PSym3 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 arg) => - Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 - type instance Apply (Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210) wild_01234567898765432100123456789876543210 = Let0123456789876543210PSym3 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 + Let0123456789876543210PSym0KindInference :: forall wild_01234567898765432100123456789876543210 + arg. SameKind (Apply Let0123456789876543210PSym0 arg) (Let0123456789876543210PSym1 arg) => + Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 + type instance Apply Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 = Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210 instance SuppressUnusedWarnings (Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Let0123456789876543210PSym1KindInference) ()) @@ -102,6 +98,21 @@ Singletons/AsPattern.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210) arg) (Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 arg) => Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 type instance Apply (Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210) wild_01234567898765432100123456789876543210 = Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Let0123456789876543210PSym2KindInference) ()) + data Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 + where + Let0123456789876543210PSym2KindInference :: forall wild_01234567898765432100123456789876543210 + wild_01234567898765432100123456789876543210 + wild_01234567898765432100123456789876543210 + arg. SameKind (Apply (Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210) arg) (Let0123456789876543210PSym3 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 arg) => + Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 + type instance Apply (Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210) wild_01234567898765432100123456789876543210 = Let0123456789876543210PSym3 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 + type Let0123456789876543210PSym3 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 = + Let0123456789876543210P wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 + type family Let0123456789876543210P wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210 where + Let0123456789876543210P wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210 = Apply (Apply (:@#@$) wild_0123456789876543210) (Apply (Apply (:@#@$) wild_0123456789876543210) wild_0123456789876543210) instance SuppressUnusedWarnings Let0123456789876543210PSym0 where suppressUnusedWarnings = snd (((,) Let0123456789876543210PSym0KindInference) ()) @@ -111,10 +122,6 @@ Singletons/AsPattern.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Let0123456789876543210PSym0 arg) (Let0123456789876543210PSym1 arg) => Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 type instance Apply Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 = Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210 - type family Let0123456789876543210P wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210 where - Let0123456789876543210P wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210 = Apply (Apply (:@#@$) wild_0123456789876543210) (Apply (Apply (:@#@$) wild_0123456789876543210) wild_0123456789876543210) - type Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 = - Let0123456789876543210P wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 instance SuppressUnusedWarnings (Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Let0123456789876543210PSym1KindInference) ()) @@ -125,6 +132,13 @@ Singletons/AsPattern.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210) arg) (Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 arg) => Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 type instance Apply (Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210) wild_01234567898765432100123456789876543210 = Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 + type Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 = + Let0123456789876543210P wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 + type family Let0123456789876543210P wild_0123456789876543210 wild_0123456789876543210 where + Let0123456789876543210P wild_0123456789876543210 wild_0123456789876543210 = Apply (Apply Tuple2Sym0 wild_0123456789876543210) wild_0123456789876543210 + type Let0123456789876543210PSym0 = Let0123456789876543210P + type family Let0123456789876543210P where + Let0123456789876543210P = NothingSym0 instance SuppressUnusedWarnings Let0123456789876543210PSym0 where suppressUnusedWarnings = snd (((,) Let0123456789876543210PSym0KindInference) ()) @@ -134,24 +148,6 @@ Singletons/AsPattern.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Let0123456789876543210PSym0 arg) (Let0123456789876543210PSym1 arg) => Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 type instance Apply Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 = Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210 - type family Let0123456789876543210P wild_0123456789876543210 wild_0123456789876543210 where - Let0123456789876543210P wild_0123456789876543210 wild_0123456789876543210 = Apply (Apply Tuple2Sym0 wild_0123456789876543210) wild_0123456789876543210 - type Let0123456789876543210PSym0 = Let0123456789876543210P - type family Let0123456789876543210P where - Let0123456789876543210P = NothingSym0 - type Let0123456789876543210PSym3 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 = - Let0123456789876543210P wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd (((,) Let0123456789876543210PSym2KindInference) ()) - data Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 - where - Let0123456789876543210PSym2KindInference :: forall wild_01234567898765432100123456789876543210 - wild_01234567898765432100123456789876543210 - wild_01234567898765432100123456789876543210 - arg. SameKind (Apply (Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210) arg) (Let0123456789876543210PSym3 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 arg) => - Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 - type instance Apply (Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210) wild_01234567898765432100123456789876543210 = Let0123456789876543210PSym3 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 instance SuppressUnusedWarnings (Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Let0123456789876543210PSym1KindInference) ()) @@ -162,19 +158,21 @@ Singletons/AsPattern.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210) arg) (Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 arg) => Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 type instance Apply (Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210) wild_01234567898765432100123456789876543210 = Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings Let0123456789876543210PSym0 where + instance SuppressUnusedWarnings (Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210) where suppressUnusedWarnings - = snd (((,) Let0123456789876543210PSym0KindInference) ()) - data Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 + = snd (((,) Let0123456789876543210PSym2KindInference) ()) + data Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 where - Let0123456789876543210PSym0KindInference :: forall wild_01234567898765432100123456789876543210 - arg. SameKind (Apply Let0123456789876543210PSym0 arg) (Let0123456789876543210PSym1 arg) => - Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 - type instance Apply Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 = Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210 + Let0123456789876543210PSym2KindInference :: forall wild_01234567898765432100123456789876543210 + wild_01234567898765432100123456789876543210 + wild_01234567898765432100123456789876543210 + arg. SameKind (Apply (Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210) arg) (Let0123456789876543210PSym3 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 arg) => + Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 + type instance Apply (Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210) wild_01234567898765432100123456789876543210 = Let0123456789876543210PSym3 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 + type Let0123456789876543210PSym3 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 = + Let0123456789876543210P wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 type family Let0123456789876543210P wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210 where Let0123456789876543210P wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210 = Apply JustSym0 (Apply (Apply (Apply BazSym0 wild_0123456789876543210) wild_0123456789876543210) wild_0123456789876543210) - type Let0123456789876543210XSym1 wild_01234567898765432100123456789876543210 = - Let0123456789876543210X wild_01234567898765432100123456789876543210 instance SuppressUnusedWarnings Let0123456789876543210XSym0 where suppressUnusedWarnings = snd (((,) Let0123456789876543210XSym0KindInference) ()) @@ -184,13 +182,13 @@ Singletons/AsPattern.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Let0123456789876543210XSym0 arg) (Let0123456789876543210XSym1 arg) => Let0123456789876543210XSym0 wild_01234567898765432100123456789876543210 type instance Apply Let0123456789876543210XSym0 wild_01234567898765432100123456789876543210 = Let0123456789876543210XSym1 wild_01234567898765432100123456789876543210 + type Let0123456789876543210XSym1 wild_01234567898765432100123456789876543210 = + Let0123456789876543210X wild_01234567898765432100123456789876543210 type family Let0123456789876543210X wild_0123456789876543210 where Let0123456789876543210X wild_0123456789876543210 = Apply JustSym0 wild_0123456789876543210 type Let0123456789876543210PSym0 = Let0123456789876543210P type family Let0123456789876543210P where Let0123456789876543210P = NothingSym0 - type FooSym1 (a0123456789876543210 :: [Nat]) = - Foo a0123456789876543210 instance SuppressUnusedWarnings FooSym0 where suppressUnusedWarnings = snd (((,) FooSym0KindInference) ()) data FooSym0 :: (~>) [Nat] [Nat] @@ -199,8 +197,8 @@ Singletons/AsPattern.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) => FooSym0 a0123456789876543210 type instance Apply FooSym0 a0123456789876543210 = FooSym1 a0123456789876543210 - type TupSym1 (a0123456789876543210 :: (Nat, Nat)) = - Tup a0123456789876543210 + type FooSym1 (a0123456789876543210 :: [Nat]) = + Foo a0123456789876543210 instance SuppressUnusedWarnings TupSym0 where suppressUnusedWarnings = snd (((,) TupSym0KindInference) ()) data TupSym0 :: (~>) (Nat, Nat) (Nat, Nat) @@ -209,8 +207,8 @@ Singletons/AsPattern.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply TupSym0 arg) (TupSym1 arg) => TupSym0 a0123456789876543210 type instance Apply TupSym0 a0123456789876543210 = TupSym1 a0123456789876543210 - type Baz_Sym1 (a0123456789876543210 :: Maybe Baz) = - Baz_ a0123456789876543210 + type TupSym1 (a0123456789876543210 :: (Nat, Nat)) = + Tup a0123456789876543210 instance SuppressUnusedWarnings Baz_Sym0 where suppressUnusedWarnings = snd (((,) Baz_Sym0KindInference) ()) data Baz_Sym0 :: (~>) (Maybe Baz) (Maybe Baz) @@ -219,8 +217,8 @@ Singletons/AsPattern.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Baz_Sym0 arg) (Baz_Sym1 arg) => Baz_Sym0 a0123456789876543210 type instance Apply Baz_Sym0 a0123456789876543210 = Baz_Sym1 a0123456789876543210 - type BarSym1 (a0123456789876543210 :: Maybe Nat) = - Bar a0123456789876543210 + type Baz_Sym1 (a0123456789876543210 :: Maybe Baz) = + Baz_ a0123456789876543210 instance SuppressUnusedWarnings BarSym0 where suppressUnusedWarnings = snd (((,) BarSym0KindInference) ()) data BarSym0 :: (~>) (Maybe Nat) (Maybe Nat) @@ -229,8 +227,8 @@ Singletons/AsPattern.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply BarSym0 arg) (BarSym1 arg) => BarSym0 a0123456789876543210 type instance Apply BarSym0 a0123456789876543210 = BarSym1 a0123456789876543210 - type MaybePlusSym1 (a0123456789876543210 :: Maybe Nat) = - MaybePlus a0123456789876543210 + type BarSym1 (a0123456789876543210 :: Maybe Nat) = + Bar a0123456789876543210 instance SuppressUnusedWarnings MaybePlusSym0 where suppressUnusedWarnings = snd (((,) MaybePlusSym0KindInference) ()) data MaybePlusSym0 :: (~>) (Maybe Nat) (Maybe Nat) @@ -239,6 +237,8 @@ Singletons/AsPattern.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply MaybePlusSym0 arg) (MaybePlusSym1 arg) => MaybePlusSym0 a0123456789876543210 type instance Apply MaybePlusSym0 a0123456789876543210 = MaybePlusSym1 a0123456789876543210 + type MaybePlusSym1 (a0123456789876543210 :: Maybe Nat) = + MaybePlus a0123456789876543210 type family Foo (a :: [Nat]) :: [Nat] where Foo '[] = Let0123456789876543210PSym0 Foo '[wild_0123456789876543210] = Let0123456789876543210PSym1 wild_0123456789876543210 diff --git a/tests/compile-and-dump/Singletons/BoundedDeriving.golden b/tests/compile-and-dump/Singletons/BoundedDeriving.golden index 246adc92..0103bba4 100644 --- a/tests/compile-and-dump/Singletons/BoundedDeriving.golden +++ b/tests/compile-and-dump/Singletons/BoundedDeriving.golden @@ -37,8 +37,6 @@ Singletons/BoundedDeriving.hs:(0,0)-(0,0): Splicing declarations type CSym0 = C type DSym0 = D type ESym0 = E - type Foo3Sym1 (t0123456789876543210 :: a0123456789876543210) = - Foo3 t0123456789876543210 instance SuppressUnusedWarnings Foo3Sym0 where suppressUnusedWarnings = snd (((,) Foo3Sym0KindInference) ()) data Foo3Sym0 :: forall a0123456789876543210. @@ -48,10 +46,18 @@ Singletons/BoundedDeriving.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Foo3Sym0 arg) (Foo3Sym1 arg) => Foo3Sym0 t0123456789876543210 type instance Apply Foo3Sym0 t0123456789876543210 = Foo3Sym1 t0123456789876543210 + type Foo3Sym1 (t0123456789876543210 :: a0123456789876543210) = + Foo3 t0123456789876543210 type Foo41Sym0 = Foo41 type Foo42Sym0 = Foo42 - type PairSym2 (t0123456789876543210 :: Bool) (t0123456789876543210 :: Bool) = - Pair t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings PairSym0 where + suppressUnusedWarnings = snd (((,) PairSym0KindInference) ()) + data PairSym0 :: (~>) Bool ((~>) Bool Pair) + where + PairSym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply PairSym0 arg) (PairSym1 arg) => + PairSym0 t0123456789876543210 + type instance Apply PairSym0 t0123456789876543210 = PairSym1 t0123456789876543210 instance SuppressUnusedWarnings (PairSym1 t0123456789876543210) where suppressUnusedWarnings = snd (((,) PairSym1KindInference) ()) data PairSym1 (t0123456789876543210 :: Bool) :: (~>) Bool Pair @@ -61,14 +67,8 @@ Singletons/BoundedDeriving.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (PairSym1 t0123456789876543210) arg) (PairSym2 t0123456789876543210 arg) => PairSym1 t0123456789876543210 t0123456789876543210 type instance Apply (PairSym1 t0123456789876543210) t0123456789876543210 = PairSym2 t0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings PairSym0 where - suppressUnusedWarnings = snd (((,) PairSym0KindInference) ()) - data PairSym0 :: (~>) Bool ((~>) Bool Pair) - where - PairSym0KindInference :: forall t0123456789876543210 - arg. SameKind (Apply PairSym0 arg) (PairSym1 arg) => - PairSym0 t0123456789876543210 - type instance Apply PairSym0 t0123456789876543210 = PairSym1 t0123456789876543210 + type PairSym2 (t0123456789876543210 :: Bool) (t0123456789876543210 :: Bool) = + Pair t0123456789876543210 t0123456789876543210 type family MinBound_0123456789876543210 :: Foo1 where MinBound_0123456789876543210 = Foo1Sym0 type MinBound_0123456789876543210Sym0 = diff --git a/tests/compile-and-dump/Singletons/BoxUnBox.golden b/tests/compile-and-dump/Singletons/BoxUnBox.golden index 22b8d4bb..4410730a 100644 --- a/tests/compile-and-dump/Singletons/BoxUnBox.golden +++ b/tests/compile-and-dump/Singletons/BoxUnBox.golden @@ -8,8 +8,6 @@ Singletons/BoxUnBox.hs:(0,0)-(0,0): Splicing declarations data Box a = FBox a unBox :: Box a -> a unBox (FBox a) = a - type FBoxSym1 (t0123456789876543210 :: a0123456789876543210) = - FBox t0123456789876543210 instance SuppressUnusedWarnings FBoxSym0 where suppressUnusedWarnings = snd (((,) FBoxSym0KindInference) ()) data FBoxSym0 :: forall a0123456789876543210. @@ -19,8 +17,8 @@ Singletons/BoxUnBox.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply FBoxSym0 arg) (FBoxSym1 arg) => FBoxSym0 t0123456789876543210 type instance Apply FBoxSym0 t0123456789876543210 = FBoxSym1 t0123456789876543210 - type UnBoxSym1 (a0123456789876543210 :: Box a0123456789876543210) = - UnBox a0123456789876543210 + type FBoxSym1 (t0123456789876543210 :: a0123456789876543210) = + FBox t0123456789876543210 instance SuppressUnusedWarnings UnBoxSym0 where suppressUnusedWarnings = snd (((,) UnBoxSym0KindInference) ()) data UnBoxSym0 :: forall a0123456789876543210. @@ -30,6 +28,8 @@ Singletons/BoxUnBox.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply UnBoxSym0 arg) (UnBoxSym1 arg) => UnBoxSym0 a0123456789876543210 type instance Apply UnBoxSym0 a0123456789876543210 = UnBoxSym1 a0123456789876543210 + type UnBoxSym1 (a0123456789876543210 :: Box a0123456789876543210) = + UnBox a0123456789876543210 type family UnBox (a :: Box a) :: a where UnBox (FBox a) = a sUnBox :: diff --git a/tests/compile-and-dump/Singletons/CaseExpressions.golden b/tests/compile-and-dump/Singletons/CaseExpressions.golden index 454df711..3538afc6 100644 --- a/tests/compile-and-dump/Singletons/CaseExpressions.golden +++ b/tests/compile-and-dump/Singletons/CaseExpressions.golden @@ -41,19 +41,15 @@ Singletons/CaseExpressions.hs:(0,0)-(0,0): Splicing declarations Case_0123456789876543210 arg_0123456789876543210 y x _ = x type family Lambda_0123456789876543210 y x t where Lambda_0123456789876543210 y x arg_0123456789876543210 = Case_0123456789876543210 arg_0123456789876543210 y x arg_0123456789876543210 - type Lambda_0123456789876543210Sym3 y0123456789876543210 x0123456789876543210 t0123456789876543210 = - Lambda_0123456789876543210 y0123456789876543210 x0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210) where + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) - data Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210 t0123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 y0123456789876543210 where - Lambda_0123456789876543210Sym2KindInference :: forall y0123456789876543210 - x0123456789876543210 - t0123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) arg) (Lambda_0123456789876543210Sym3 y0123456789876543210 x0123456789876543210 arg) => - Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210 t0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 t0123456789876543210 + Lambda_0123456789876543210Sym0KindInference :: forall y0123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 y0123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 y0123456789876543210 = Lambda_0123456789876543210Sym1 y0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 y0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) @@ -64,19 +60,30 @@ Singletons/CaseExpressions.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Lambda_0123456789876543210Sym1 y0123456789876543210) arg) (Lambda_0123456789876543210Sym2 y0123456789876543210 arg) => Lambda_0123456789876543210Sym1 y0123456789876543210 x0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 y0123456789876543210) x0123456789876543210 = Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) - data Lambda_0123456789876543210Sym0 y0123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210 t0123456789876543210 where - Lambda_0123456789876543210Sym0KindInference :: forall y0123456789876543210 - arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 y0123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 y0123456789876543210 = Lambda_0123456789876543210Sym1 y0123456789876543210 + Lambda_0123456789876543210Sym2KindInference :: forall y0123456789876543210 + x0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) arg) (Lambda_0123456789876543210Sym3 y0123456789876543210 x0123456789876543210 arg) => + Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym3 y0123456789876543210 x0123456789876543210 t0123456789876543210 + type Lambda_0123456789876543210Sym3 y0123456789876543210 x0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 y0123456789876543210 x0123456789876543210 t0123456789876543210 type family Case_0123456789876543210 x t where Case_0123456789876543210 x y = Apply (Apply (Apply Lambda_0123456789876543210Sym0 y) x) y - type Let0123456789876543210ZSym2 y0123456789876543210 x0123456789876543210 = - Let0123456789876543210Z y0123456789876543210 x0123456789876543210 + instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where + suppressUnusedWarnings + = snd (((,) Let0123456789876543210ZSym0KindInference) ()) + data Let0123456789876543210ZSym0 y0123456789876543210 + where + Let0123456789876543210ZSym0KindInference :: forall y0123456789876543210 + arg. SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) => + Let0123456789876543210ZSym0 y0123456789876543210 + type instance Apply Let0123456789876543210ZSym0 y0123456789876543210 = Let0123456789876543210ZSym1 y0123456789876543210 instance SuppressUnusedWarnings (Let0123456789876543210ZSym1 y0123456789876543210) where suppressUnusedWarnings = snd (((,) Let0123456789876543210ZSym1KindInference) ()) @@ -87,21 +94,24 @@ Singletons/CaseExpressions.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Let0123456789876543210ZSym1 y0123456789876543210) arg) (Let0123456789876543210ZSym2 y0123456789876543210 arg) => Let0123456789876543210ZSym1 y0123456789876543210 x0123456789876543210 type instance Apply (Let0123456789876543210ZSym1 y0123456789876543210) x0123456789876543210 = Let0123456789876543210ZSym2 y0123456789876543210 x0123456789876543210 - instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where - suppressUnusedWarnings - = snd (((,) Let0123456789876543210ZSym0KindInference) ()) - data Let0123456789876543210ZSym0 y0123456789876543210 - where - Let0123456789876543210ZSym0KindInference :: forall y0123456789876543210 - arg. SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) => - Let0123456789876543210ZSym0 y0123456789876543210 - type instance Apply Let0123456789876543210ZSym0 y0123456789876543210 = Let0123456789876543210ZSym1 y0123456789876543210 + type Let0123456789876543210ZSym2 y0123456789876543210 x0123456789876543210 = + Let0123456789876543210Z y0123456789876543210 x0123456789876543210 type family Let0123456789876543210Z y x :: a where Let0123456789876543210Z y x = y type family Case_0123456789876543210 x t where Case_0123456789876543210 x y = Let0123456789876543210ZSym2 y x - type Let0123456789876543210Scrutinee_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210 = - Let0123456789876543210Scrutinee_0123456789876543210 a0123456789876543210 b0123456789876543210 + instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd + (((,) + Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference) + ()) + data Let0123456789876543210Scrutinee_0123456789876543210Sym0 a0123456789876543210 + where + Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) => + Let0123456789876543210Scrutinee_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 a0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210Sym1 a0123456789876543210 instance SuppressUnusedWarnings (Let0123456789876543210Scrutinee_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd @@ -115,24 +125,12 @@ Singletons/CaseExpressions.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym1 a0123456789876543210) arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym2 a0123456789876543210 arg) => Let0123456789876543210Scrutinee_0123456789876543210Sym1 a0123456789876543210 b0123456789876543210 type instance Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym1 a0123456789876543210) b0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210 - instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd - (((,) - Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference) - ()) - data Let0123456789876543210Scrutinee_0123456789876543210Sym0 a0123456789876543210 - where - Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) => - Let0123456789876543210Scrutinee_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 a0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210Sym1 a0123456789876543210 + type Let0123456789876543210Scrutinee_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210 = + Let0123456789876543210Scrutinee_0123456789876543210 a0123456789876543210 b0123456789876543210 type family Let0123456789876543210Scrutinee_0123456789876543210 a b where Let0123456789876543210Scrutinee_0123456789876543210 a b = Apply (Apply Tuple2Sym0 a) b type family Case_0123456789876543210 a b t where Case_0123456789876543210 a b '(p, _) = p - type Let0123456789876543210Scrutinee_0123456789876543210Sym1 d0123456789876543210 = - Let0123456789876543210Scrutinee_0123456789876543210 d0123456789876543210 instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where suppressUnusedWarnings = snd @@ -145,6 +143,8 @@ Singletons/CaseExpressions.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) => Let0123456789876543210Scrutinee_0123456789876543210Sym0 d0123456789876543210 type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 d0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210Sym1 d0123456789876543210 + type Let0123456789876543210Scrutinee_0123456789876543210Sym1 d0123456789876543210 = + Let0123456789876543210Scrutinee_0123456789876543210 d0123456789876543210 type family Let0123456789876543210Scrutinee_0123456789876543210 d where Let0123456789876543210Scrutinee_0123456789876543210 d = Apply JustSym0 d type family Case_0123456789876543210 d t where @@ -152,8 +152,6 @@ Singletons/CaseExpressions.hs:(0,0)-(0,0): Splicing declarations type family Case_0123456789876543210 d x t where Case_0123456789876543210 d x ('Just y) = y Case_0123456789876543210 d x 'Nothing = d - type Foo5Sym1 (a0123456789876543210 :: a0123456789876543210) = - Foo5 a0123456789876543210 instance SuppressUnusedWarnings Foo5Sym0 where suppressUnusedWarnings = snd (((,) Foo5Sym0KindInference) ()) data Foo5Sym0 :: forall a0123456789876543210. @@ -163,8 +161,8 @@ Singletons/CaseExpressions.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Foo5Sym0 arg) (Foo5Sym1 arg) => Foo5Sym0 a0123456789876543210 type instance Apply Foo5Sym0 a0123456789876543210 = Foo5Sym1 a0123456789876543210 - type Foo4Sym1 (a0123456789876543210 :: a0123456789876543210) = - Foo4 a0123456789876543210 + type Foo5Sym1 (a0123456789876543210 :: a0123456789876543210) = + Foo5 a0123456789876543210 instance SuppressUnusedWarnings Foo4Sym0 where suppressUnusedWarnings = snd (((,) Foo4Sym0KindInference) ()) data Foo4Sym0 :: forall a0123456789876543210. @@ -174,18 +172,8 @@ Singletons/CaseExpressions.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Foo4Sym0 arg) (Foo4Sym1 arg) => Foo4Sym0 a0123456789876543210 type instance Apply Foo4Sym0 a0123456789876543210 = Foo4Sym1 a0123456789876543210 - type Foo3Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = - Foo3 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (Foo3Sym1 a0123456789876543210) where - suppressUnusedWarnings = snd (((,) Foo3Sym1KindInference) ()) - data Foo3Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. - (~>) b0123456789876543210 a0123456789876543210 - where - Foo3Sym1KindInference :: forall a0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply (Foo3Sym1 a0123456789876543210) arg) (Foo3Sym2 a0123456789876543210 arg) => - Foo3Sym1 a0123456789876543210 a0123456789876543210 - type instance Apply (Foo3Sym1 a0123456789876543210) a0123456789876543210 = Foo3Sym2 a0123456789876543210 a0123456789876543210 + type Foo4Sym1 (a0123456789876543210 :: a0123456789876543210) = + Foo4 a0123456789876543210 instance SuppressUnusedWarnings Foo3Sym0 where suppressUnusedWarnings = snd (((,) Foo3Sym0KindInference) ()) data Foo3Sym0 :: forall a0123456789876543210 b0123456789876543210. @@ -195,17 +183,18 @@ Singletons/CaseExpressions.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Foo3Sym0 arg) (Foo3Sym1 arg) => Foo3Sym0 a0123456789876543210 type instance Apply Foo3Sym0 a0123456789876543210 = Foo3Sym1 a0123456789876543210 - type Foo2Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: Maybe a0123456789876543210) = - Foo2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (Foo2Sym1 a0123456789876543210) where - suppressUnusedWarnings = snd (((,) Foo2Sym1KindInference) ()) - data Foo2Sym1 (a0123456789876543210 :: a0123456789876543210) :: (~>) (Maybe a0123456789876543210) a0123456789876543210 + instance SuppressUnusedWarnings (Foo3Sym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) Foo3Sym1KindInference) ()) + data Foo3Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. + (~>) b0123456789876543210 a0123456789876543210 where - Foo2Sym1KindInference :: forall a0123456789876543210 + Foo3Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 - arg. SameKind (Apply (Foo2Sym1 a0123456789876543210) arg) (Foo2Sym2 a0123456789876543210 arg) => - Foo2Sym1 a0123456789876543210 a0123456789876543210 - type instance Apply (Foo2Sym1 a0123456789876543210) a0123456789876543210 = Foo2Sym2 a0123456789876543210 a0123456789876543210 + arg. SameKind (Apply (Foo3Sym1 a0123456789876543210) arg) (Foo3Sym2 a0123456789876543210 arg) => + Foo3Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Foo3Sym1 a0123456789876543210) a0123456789876543210 = Foo3Sym2 a0123456789876543210 a0123456789876543210 + type Foo3Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = + Foo3 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Foo2Sym0 where suppressUnusedWarnings = snd (((,) Foo2Sym0KindInference) ()) data Foo2Sym0 :: forall a0123456789876543210. @@ -215,17 +204,17 @@ Singletons/CaseExpressions.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Foo2Sym0 arg) (Foo2Sym1 arg) => Foo2Sym0 a0123456789876543210 type instance Apply Foo2Sym0 a0123456789876543210 = Foo2Sym1 a0123456789876543210 - type Foo1Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: Maybe a0123456789876543210) = - Foo1 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (Foo1Sym1 a0123456789876543210) where - suppressUnusedWarnings = snd (((,) Foo1Sym1KindInference) ()) - data Foo1Sym1 (a0123456789876543210 :: a0123456789876543210) :: (~>) (Maybe a0123456789876543210) a0123456789876543210 + instance SuppressUnusedWarnings (Foo2Sym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) Foo2Sym1KindInference) ()) + data Foo2Sym1 (a0123456789876543210 :: a0123456789876543210) :: (~>) (Maybe a0123456789876543210) a0123456789876543210 where - Foo1Sym1KindInference :: forall a0123456789876543210 + Foo2Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 - arg. SameKind (Apply (Foo1Sym1 a0123456789876543210) arg) (Foo1Sym2 a0123456789876543210 arg) => - Foo1Sym1 a0123456789876543210 a0123456789876543210 - type instance Apply (Foo1Sym1 a0123456789876543210) a0123456789876543210 = Foo1Sym2 a0123456789876543210 a0123456789876543210 + arg. SameKind (Apply (Foo2Sym1 a0123456789876543210) arg) (Foo2Sym2 a0123456789876543210 arg) => + Foo2Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Foo2Sym1 a0123456789876543210) a0123456789876543210 = Foo2Sym2 a0123456789876543210 a0123456789876543210 + type Foo2Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: Maybe a0123456789876543210) = + Foo2 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Foo1Sym0 where suppressUnusedWarnings = snd (((,) Foo1Sym0KindInference) ()) data Foo1Sym0 :: forall a0123456789876543210. @@ -235,6 +224,17 @@ Singletons/CaseExpressions.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Foo1Sym0 arg) (Foo1Sym1 arg) => Foo1Sym0 a0123456789876543210 type instance Apply Foo1Sym0 a0123456789876543210 = Foo1Sym1 a0123456789876543210 + instance SuppressUnusedWarnings (Foo1Sym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) Foo1Sym1KindInference) ()) + data Foo1Sym1 (a0123456789876543210 :: a0123456789876543210) :: (~>) (Maybe a0123456789876543210) a0123456789876543210 + where + Foo1Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Foo1Sym1 a0123456789876543210) arg) (Foo1Sym2 a0123456789876543210 arg) => + Foo1Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Foo1Sym1 a0123456789876543210) a0123456789876543210 = Foo1Sym2 a0123456789876543210 a0123456789876543210 + type Foo1Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: Maybe a0123456789876543210) = + Foo1 a0123456789876543210 a0123456789876543210 type family Foo5 (a :: a) :: a where Foo5 x = Case_0123456789876543210 x x type family Foo4 (a :: a) :: a where diff --git a/tests/compile-and-dump/Singletons/Classes.golden b/tests/compile-and-dump/Singletons/Classes.golden index 58450c4c..af7ac143 100644 --- a/tests/compile-and-dump/Singletons/Classes.golden +++ b/tests/compile-and-dump/Singletons/Classes.golden @@ -65,8 +65,14 @@ Singletons/Classes.hs:(0,0)-(0,0): Splicing declarations type BSym0 = B type FSym0 = F type GSym0 = G - type FooCompareSym2 (a0123456789876543210 :: Foo) (a0123456789876543210 :: Foo) = - FooCompare a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings FooCompareSym0 where + suppressUnusedWarnings = snd (((,) FooCompareSym0KindInference) ()) + data FooCompareSym0 :: (~>) Foo ((~>) Foo Ordering) + where + FooCompareSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply FooCompareSym0 arg) (FooCompareSym1 arg) => + FooCompareSym0 a0123456789876543210 + type instance Apply FooCompareSym0 a0123456789876543210 = FooCompareSym1 a0123456789876543210 instance SuppressUnusedWarnings (FooCompareSym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) FooCompareSym1KindInference) ()) data FooCompareSym1 (a0123456789876543210 :: Foo) :: (~>) Foo Ordering @@ -76,16 +82,17 @@ Singletons/Classes.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (FooCompareSym1 a0123456789876543210) arg) (FooCompareSym2 a0123456789876543210 arg) => FooCompareSym1 a0123456789876543210 a0123456789876543210 type instance Apply (FooCompareSym1 a0123456789876543210) a0123456789876543210 = FooCompareSym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings FooCompareSym0 where - suppressUnusedWarnings = snd (((,) FooCompareSym0KindInference) ()) - data FooCompareSym0 :: (~>) Foo ((~>) Foo Ordering) + type FooCompareSym2 (a0123456789876543210 :: Foo) (a0123456789876543210 :: Foo) = + FooCompare a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings ConstSym0 where + suppressUnusedWarnings = snd (((,) ConstSym0KindInference) ()) + data ConstSym0 :: forall a0123456789876543210 b0123456789876543210. + (~>) a0123456789876543210 ((~>) b0123456789876543210 a0123456789876543210) where - FooCompareSym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply FooCompareSym0 arg) (FooCompareSym1 arg) => - FooCompareSym0 a0123456789876543210 - type instance Apply FooCompareSym0 a0123456789876543210 = FooCompareSym1 a0123456789876543210 - type ConstSym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = - Const a0123456789876543210 a0123456789876543210 + ConstSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply ConstSym0 arg) (ConstSym1 arg) => + ConstSym0 a0123456789876543210 + type instance Apply ConstSym0 a0123456789876543210 = ConstSym1 a0123456789876543210 instance SuppressUnusedWarnings (ConstSym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ConstSym1KindInference) ()) data ConstSym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. @@ -96,15 +103,8 @@ Singletons/Classes.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (ConstSym1 a0123456789876543210) arg) (ConstSym2 a0123456789876543210 arg) => ConstSym1 a0123456789876543210 a0123456789876543210 type instance Apply (ConstSym1 a0123456789876543210) a0123456789876543210 = ConstSym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ConstSym0 where - suppressUnusedWarnings = snd (((,) ConstSym0KindInference) ()) - data ConstSym0 :: forall a0123456789876543210 b0123456789876543210. - (~>) a0123456789876543210 ((~>) b0123456789876543210 a0123456789876543210) - where - ConstSym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply ConstSym0 arg) (ConstSym1 arg) => - ConstSym0 a0123456789876543210 - type instance Apply ConstSym0 a0123456789876543210 = ConstSym1 a0123456789876543210 + type ConstSym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = + Const a0123456789876543210 a0123456789876543210 type family FooCompare (a :: Foo) (a :: Foo) :: Ordering where FooCompare A A = EQSym0 FooCompare A B = LTSym0 @@ -112,17 +112,6 @@ Singletons/Classes.hs:(0,0)-(0,0): Splicing declarations FooCompare B A = EQSym0 type family Const (a :: a) (a :: b) :: a where Const x _ = x - type MycompareSym2 (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: a0123456789876543210) = - Mycompare arg0123456789876543210 arg0123456789876543210 - instance SuppressUnusedWarnings (MycompareSym1 arg0123456789876543210) where - suppressUnusedWarnings = snd (((,) MycompareSym1KindInference) ()) - data MycompareSym1 (arg0123456789876543210 :: a0123456789876543210) :: (~>) a0123456789876543210 Ordering - where - MycompareSym1KindInference :: forall arg0123456789876543210 - arg0123456789876543210 - arg. SameKind (Apply (MycompareSym1 arg0123456789876543210) arg) (MycompareSym2 arg0123456789876543210 arg) => - MycompareSym1 arg0123456789876543210 arg0123456789876543210 - type instance Apply (MycompareSym1 arg0123456789876543210) arg0123456789876543210 = MycompareSym2 arg0123456789876543210 arg0123456789876543210 instance SuppressUnusedWarnings MycompareSym0 where suppressUnusedWarnings = snd (((,) MycompareSym0KindInference) ()) data MycompareSym0 :: forall a0123456789876543210. @@ -132,19 +121,17 @@ Singletons/Classes.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply MycompareSym0 arg) (MycompareSym1 arg) => MycompareSym0 arg0123456789876543210 type instance Apply MycompareSym0 arg0123456789876543210 = MycompareSym1 arg0123456789876543210 - type (<=>@#@$$$) (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: a0123456789876543210) = - (<=>) arg0123456789876543210 arg0123456789876543210 - infix 4 <=>@#@$$$ - instance SuppressUnusedWarnings ((<=>@#@$$) arg0123456789876543210) where - suppressUnusedWarnings = snd (((,) (:<=>@#@$$###)) ()) - data (<=>@#@$$) (arg0123456789876543210 :: a0123456789876543210) :: (~>) a0123456789876543210 Ordering + instance SuppressUnusedWarnings (MycompareSym1 arg0123456789876543210) where + suppressUnusedWarnings = snd (((,) MycompareSym1KindInference) ()) + data MycompareSym1 (arg0123456789876543210 :: a0123456789876543210) :: (~>) a0123456789876543210 Ordering where - (:<=>@#@$$###) :: forall arg0123456789876543210 - arg0123456789876543210 - arg. SameKind (Apply ((<=>@#@$$) arg0123456789876543210) arg) ((<=>@#@$$$) arg0123456789876543210 arg) => - (<=>@#@$$) arg0123456789876543210 arg0123456789876543210 - type instance Apply ((<=>@#@$$) arg0123456789876543210) arg0123456789876543210 = (<=>@#@$$$) arg0123456789876543210 arg0123456789876543210 - infix 4 <=>@#@$$ + MycompareSym1KindInference :: forall arg0123456789876543210 + arg0123456789876543210 + arg. SameKind (Apply (MycompareSym1 arg0123456789876543210) arg) (MycompareSym2 arg0123456789876543210 arg) => + MycompareSym1 arg0123456789876543210 arg0123456789876543210 + type instance Apply (MycompareSym1 arg0123456789876543210) arg0123456789876543210 = MycompareSym2 arg0123456789876543210 arg0123456789876543210 + type MycompareSym2 (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: a0123456789876543210) = + Mycompare arg0123456789876543210 arg0123456789876543210 instance SuppressUnusedWarnings (<=>@#@$) where suppressUnusedWarnings = snd (((,) (:<=>@#@$###)) ()) data (<=>@#@$) :: forall a0123456789876543210. @@ -155,20 +142,21 @@ Singletons/Classes.hs:(0,0)-(0,0): Splicing declarations (<=>@#@$) arg0123456789876543210 type instance Apply (<=>@#@$) arg0123456789876543210 = (<=>@#@$$) arg0123456789876543210 infix 4 <=>@#@$ + instance SuppressUnusedWarnings ((<=>@#@$$) arg0123456789876543210) where + suppressUnusedWarnings = snd (((,) (:<=>@#@$$###)) ()) + data (<=>@#@$$) (arg0123456789876543210 :: a0123456789876543210) :: (~>) a0123456789876543210 Ordering + where + (:<=>@#@$$###) :: forall arg0123456789876543210 + arg0123456789876543210 + arg. SameKind (Apply ((<=>@#@$$) arg0123456789876543210) arg) ((<=>@#@$$$) arg0123456789876543210 arg) => + (<=>@#@$$) arg0123456789876543210 arg0123456789876543210 + type instance Apply ((<=>@#@$$) arg0123456789876543210) arg0123456789876543210 = (<=>@#@$$$) arg0123456789876543210 arg0123456789876543210 + infix 4 <=>@#@$$ + type (<=>@#@$$$) (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: a0123456789876543210) = + (<=>) arg0123456789876543210 arg0123456789876543210 + infix 4 <=>@#@$$$ type family TFHelper_0123456789876543210 (a :: a) (a :: a) :: Ordering where TFHelper_0123456789876543210 a_0123456789876543210 a_0123456789876543210 = Apply (Apply MycompareSym0 a_0123456789876543210) a_0123456789876543210 - type TFHelper_0123456789876543210Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: a0123456789876543210) = - TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (TFHelper_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd (((,) TFHelper_0123456789876543210Sym1KindInference) ()) - data TFHelper_0123456789876543210Sym1 (a0123456789876543210 :: a0123456789876543210) :: (~>) a0123456789876543210 Ordering - where - TFHelper_0123456789876543210Sym1KindInference :: forall a0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply (TFHelper_0123456789876543210Sym1 a0123456789876543210) arg) (TFHelper_0123456789876543210Sym2 a0123456789876543210 arg) => - TFHelper_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 - type instance Apply (TFHelper_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = TFHelper_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) TFHelper_0123456789876543210Sym0KindInference) ()) @@ -179,6 +167,18 @@ Singletons/Classes.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply TFHelper_0123456789876543210Sym0 arg) (TFHelper_0123456789876543210Sym1 arg) => TFHelper_0123456789876543210Sym0 a0123456789876543210 type instance Apply TFHelper_0123456789876543210Sym0 a0123456789876543210 = TFHelper_0123456789876543210Sym1 a0123456789876543210 + instance SuppressUnusedWarnings (TFHelper_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) TFHelper_0123456789876543210Sym1KindInference) ()) + data TFHelper_0123456789876543210Sym1 (a0123456789876543210 :: a0123456789876543210) :: (~>) a0123456789876543210 Ordering + where + TFHelper_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (TFHelper_0123456789876543210Sym1 a0123456789876543210) arg) (TFHelper_0123456789876543210Sym2 a0123456789876543210 arg) => + TFHelper_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (TFHelper_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = TFHelper_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 + type TFHelper_0123456789876543210Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: a0123456789876543210) = + TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210 class PMyOrd a where type Mycompare (arg :: a) (arg :: a) :: Ordering type (<=>) (arg :: a) (arg :: a) :: Ordering @@ -188,8 +188,15 @@ Singletons/Classes.hs:(0,0)-(0,0): Splicing declarations Mycompare_0123456789876543210 'Zero ('Succ _) = LTSym0 Mycompare_0123456789876543210 ('Succ _) 'Zero = GTSym0 Mycompare_0123456789876543210 ('Succ n) ('Succ m) = Apply (Apply MycompareSym0 m) n - type Mycompare_0123456789876543210Sym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) = - Mycompare_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Mycompare_0123456789876543210Sym0KindInference) ()) + data Mycompare_0123456789876543210Sym0 :: (~>) Nat ((~>) Nat Ordering) + where + Mycompare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) => + Mycompare_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Mycompare_0123456789876543210Sym0 a0123456789876543210 = Mycompare_0123456789876543210Sym1 a0123456789876543210 instance SuppressUnusedWarnings (Mycompare_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Mycompare_0123456789876543210Sym1KindInference) ()) @@ -200,21 +207,21 @@ Singletons/Classes.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Mycompare_0123456789876543210Sym1 a0123456789876543210) arg) (Mycompare_0123456789876543210Sym2 a0123456789876543210 arg) => Mycompare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Mycompare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Mycompare_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 + type Mycompare_0123456789876543210Sym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) = + Mycompare_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance PMyOrd Nat where + type Mycompare a a = Apply (Apply Mycompare_0123456789876543210Sym0 a) a + type family Mycompare_0123456789876543210 (a :: ()) (a :: ()) :: Ordering where + Mycompare_0123456789876543210 _ a_0123456789876543210 = Apply (Apply ConstSym0 EQSym0) a_0123456789876543210 instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Mycompare_0123456789876543210Sym0KindInference) ()) - data Mycompare_0123456789876543210Sym0 :: (~>) Nat ((~>) Nat Ordering) + data Mycompare_0123456789876543210Sym0 :: (~>) () ((~>) () Ordering) where Mycompare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) => Mycompare_0123456789876543210Sym0 a0123456789876543210 type instance Apply Mycompare_0123456789876543210Sym0 a0123456789876543210 = Mycompare_0123456789876543210Sym1 a0123456789876543210 - instance PMyOrd Nat where - type Mycompare a a = Apply (Apply Mycompare_0123456789876543210Sym0 a) a - type family Mycompare_0123456789876543210 (a :: ()) (a :: ()) :: Ordering where - Mycompare_0123456789876543210 _ a_0123456789876543210 = Apply (Apply ConstSym0 EQSym0) a_0123456789876543210 - type Mycompare_0123456789876543210Sym2 (a0123456789876543210 :: ()) (a0123456789876543210 :: ()) = - Mycompare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Mycompare_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Mycompare_0123456789876543210Sym1KindInference) ()) @@ -225,21 +232,21 @@ Singletons/Classes.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Mycompare_0123456789876543210Sym1 a0123456789876543210) arg) (Mycompare_0123456789876543210Sym2 a0123456789876543210 arg) => Mycompare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Mycompare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Mycompare_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 + type Mycompare_0123456789876543210Sym2 (a0123456789876543210 :: ()) (a0123456789876543210 :: ()) = + Mycompare_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance PMyOrd () where + type Mycompare a a = Apply (Apply Mycompare_0123456789876543210Sym0 a) a + type family Mycompare_0123456789876543210 (a :: Foo) (a :: Foo) :: Ordering where + Mycompare_0123456789876543210 a_0123456789876543210 a_0123456789876543210 = Apply (Apply FooCompareSym0 a_0123456789876543210) a_0123456789876543210 instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Mycompare_0123456789876543210Sym0KindInference) ()) - data Mycompare_0123456789876543210Sym0 :: (~>) () ((~>) () Ordering) + data Mycompare_0123456789876543210Sym0 :: (~>) Foo ((~>) Foo Ordering) where Mycompare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) => Mycompare_0123456789876543210Sym0 a0123456789876543210 type instance Apply Mycompare_0123456789876543210Sym0 a0123456789876543210 = Mycompare_0123456789876543210Sym1 a0123456789876543210 - instance PMyOrd () where - type Mycompare a a = Apply (Apply Mycompare_0123456789876543210Sym0 a) a - type family Mycompare_0123456789876543210 (a :: Foo) (a :: Foo) :: Ordering where - Mycompare_0123456789876543210 a_0123456789876543210 a_0123456789876543210 = Apply (Apply FooCompareSym0 a_0123456789876543210) a_0123456789876543210 - type Mycompare_0123456789876543210Sym2 (a0123456789876543210 :: Foo) (a0123456789876543210 :: Foo) = - Mycompare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Mycompare_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Mycompare_0123456789876543210Sym1KindInference) ()) @@ -250,15 +257,8 @@ Singletons/Classes.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Mycompare_0123456789876543210Sym1 a0123456789876543210) arg) (Mycompare_0123456789876543210Sym2 a0123456789876543210 arg) => Mycompare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Mycompare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Mycompare_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd (((,) Mycompare_0123456789876543210Sym0KindInference) ()) - data Mycompare_0123456789876543210Sym0 :: (~>) Foo ((~>) Foo Ordering) - where - Mycompare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) => - Mycompare_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Mycompare_0123456789876543210Sym0 a0123456789876543210 = Mycompare_0123456789876543210Sym1 a0123456789876543210 + type Mycompare_0123456789876543210Sym2 (a0123456789876543210 :: Foo) (a0123456789876543210 :: Foo) = + Mycompare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance PMyOrd Foo where type Mycompare a a = Apply (Apply Mycompare_0123456789876543210Sym0 a) a type family TFHelper_0123456789876543210 (a :: Foo2) (a :: Foo2) :: Bool where @@ -266,8 +266,15 @@ Singletons/Classes.hs:(0,0)-(0,0): Splicing declarations TFHelper_0123456789876543210 G G = TrueSym0 TFHelper_0123456789876543210 F G = FalseSym0 TFHelper_0123456789876543210 G F = FalseSym0 - type TFHelper_0123456789876543210Sym2 (a0123456789876543210 :: Foo2) (a0123456789876543210 :: Foo2) = - TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) TFHelper_0123456789876543210Sym0KindInference) ()) + data TFHelper_0123456789876543210Sym0 :: (~>) Foo2 ((~>) Foo2 Bool) + where + TFHelper_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply TFHelper_0123456789876543210Sym0 arg) (TFHelper_0123456789876543210Sym1 arg) => + TFHelper_0123456789876543210Sym0 a0123456789876543210 + type instance Apply TFHelper_0123456789876543210Sym0 a0123456789876543210 = TFHelper_0123456789876543210Sym1 a0123456789876543210 instance SuppressUnusedWarnings (TFHelper_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) TFHelper_0123456789876543210Sym1KindInference) ()) @@ -278,15 +285,8 @@ Singletons/Classes.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (TFHelper_0123456789876543210Sym1 a0123456789876543210) arg) (TFHelper_0123456789876543210Sym2 a0123456789876543210 arg) => TFHelper_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (TFHelper_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = TFHelper_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd (((,) TFHelper_0123456789876543210Sym0KindInference) ()) - data TFHelper_0123456789876543210Sym0 :: (~>) Foo2 ((~>) Foo2 Bool) - where - TFHelper_0123456789876543210Sym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply TFHelper_0123456789876543210Sym0 arg) (TFHelper_0123456789876543210Sym1 arg) => - TFHelper_0123456789876543210Sym0 a0123456789876543210 - type instance Apply TFHelper_0123456789876543210Sym0 a0123456789876543210 = TFHelper_0123456789876543210Sym1 a0123456789876543210 + type TFHelper_0123456789876543210Sym2 (a0123456789876543210 :: Foo2) (a0123456789876543210 :: Foo2) = + TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210 instance PEq Foo2 where type (==) a a = Apply (Apply TFHelper_0123456789876543210Sym0 a) a infix 4 %<=> @@ -436,8 +436,15 @@ Singletons/Classes.hs:(0,0)-(0,0): Splicing declarations Mycompare_0123456789876543210 'F 'F = EQSym0 Mycompare_0123456789876543210 'F _ = LTSym0 Mycompare_0123456789876543210 _ _ = GTSym0 - type Mycompare_0123456789876543210Sym2 (a0123456789876543210 :: Foo2) (a0123456789876543210 :: Foo2) = - Mycompare_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Mycompare_0123456789876543210Sym0KindInference) ()) + data Mycompare_0123456789876543210Sym0 :: (~>) Foo2 ((~>) Foo2 Ordering) + where + Mycompare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) => + Mycompare_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Mycompare_0123456789876543210Sym0 a0123456789876543210 = Mycompare_0123456789876543210Sym1 a0123456789876543210 instance SuppressUnusedWarnings (Mycompare_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Mycompare_0123456789876543210Sym1KindInference) ()) @@ -448,23 +455,23 @@ Singletons/Classes.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Mycompare_0123456789876543210Sym1 a0123456789876543210) arg) (Mycompare_0123456789876543210Sym2 a0123456789876543210 arg) => Mycompare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Mycompare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Mycompare_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd (((,) Mycompare_0123456789876543210Sym0KindInference) ()) - data Mycompare_0123456789876543210Sym0 :: (~>) Foo2 ((~>) Foo2 Ordering) - where - Mycompare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) => - Mycompare_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Mycompare_0123456789876543210Sym0 a0123456789876543210 = Mycompare_0123456789876543210Sym1 a0123456789876543210 + type Mycompare_0123456789876543210Sym2 (a0123456789876543210 :: Foo2) (a0123456789876543210 :: Foo2) = + Mycompare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance PMyOrd Foo2 where type Mycompare a a = Apply (Apply Mycompare_0123456789876543210Sym0 a) a type family Compare_0123456789876543210 (a :: Foo2) (a :: Foo2) :: Ordering where Compare_0123456789876543210 'F 'F = EQSym0 Compare_0123456789876543210 'F _ = LTSym0 Compare_0123456789876543210 _ _ = GTSym0 - type Compare_0123456789876543210Sym2 (a0123456789876543210 :: Foo2) (a0123456789876543210 :: Foo2) = - Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Compare_0123456789876543210Sym0KindInference) ()) + data Compare_0123456789876543210Sym0 :: (~>) Foo2 ((~>) Foo2 Ordering) + where + Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => + Compare_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 instance SuppressUnusedWarnings (Compare_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Compare_0123456789876543210Sym1KindInference) ()) @@ -475,15 +482,8 @@ Singletons/Classes.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Compare_0123456789876543210Sym1 a0123456789876543210) arg) (Compare_0123456789876543210Sym2 a0123456789876543210 arg) => Compare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Compare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Compare_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd (((,) Compare_0123456789876543210Sym0KindInference) ()) - data Compare_0123456789876543210Sym0 :: (~>) Foo2 ((~>) Foo2 Ordering) - where - Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => - Compare_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 + type Compare_0123456789876543210Sym2 (a0123456789876543210 :: Foo2) (a0123456789876543210 :: Foo2) = + Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance POrd Foo2 where type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a Singletons/Classes.hs:(0,0)-(0,0): Splicing declarations @@ -503,8 +503,6 @@ Singletons/Classes.hs:(0,0)-(0,0): Splicing declarations mycompare (Succ' _) Zero' = GT mycompare (Succ' n) (Succ' m) = (m `mycompare` n) type Zero'Sym0 = Zero' - type Succ'Sym1 (t0123456789876543210 :: Nat') = - Succ' t0123456789876543210 instance SuppressUnusedWarnings Succ'Sym0 where suppressUnusedWarnings = snd (((,) Succ'Sym0KindInference) ()) data Succ'Sym0 :: (~>) Nat' Nat' @@ -513,13 +511,22 @@ Singletons/Classes.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Succ'Sym0 arg) (Succ'Sym1 arg) => Succ'Sym0 t0123456789876543210 type instance Apply Succ'Sym0 t0123456789876543210 = Succ'Sym1 t0123456789876543210 + type Succ'Sym1 (t0123456789876543210 :: Nat') = + Succ' t0123456789876543210 type family Mycompare_0123456789876543210 (a :: Nat') (a :: Nat') :: Ordering where Mycompare_0123456789876543210 Zero' Zero' = EQSym0 Mycompare_0123456789876543210 Zero' (Succ' _) = LTSym0 Mycompare_0123456789876543210 (Succ' _) Zero' = GTSym0 Mycompare_0123456789876543210 (Succ' n) (Succ' m) = Apply (Apply MycompareSym0 m) n - type Mycompare_0123456789876543210Sym2 (a0123456789876543210 :: Nat') (a0123456789876543210 :: Nat') = - Mycompare_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Mycompare_0123456789876543210Sym0KindInference) ()) + data Mycompare_0123456789876543210Sym0 :: (~>) Nat' ((~>) Nat' Ordering) + where + Mycompare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) => + Mycompare_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Mycompare_0123456789876543210Sym0 a0123456789876543210 = Mycompare_0123456789876543210Sym1 a0123456789876543210 instance SuppressUnusedWarnings (Mycompare_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Mycompare_0123456789876543210Sym1KindInference) ()) @@ -530,15 +537,8 @@ Singletons/Classes.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Mycompare_0123456789876543210Sym1 a0123456789876543210) arg) (Mycompare_0123456789876543210Sym2 a0123456789876543210 arg) => Mycompare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Mycompare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Mycompare_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd (((,) Mycompare_0123456789876543210Sym0KindInference) ()) - data Mycompare_0123456789876543210Sym0 :: (~>) Nat' ((~>) Nat' Ordering) - where - Mycompare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) => - Mycompare_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Mycompare_0123456789876543210Sym0 a0123456789876543210 = Mycompare_0123456789876543210Sym1 a0123456789876543210 + type Mycompare_0123456789876543210Sym2 (a0123456789876543210 :: Nat') (a0123456789876543210 :: Nat') = + Mycompare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance PMyOrd Nat' where type Mycompare a a = Apply (Apply Mycompare_0123456789876543210Sym0 a) a data SNat' :: Nat' -> GHC.Types.Type diff --git a/tests/compile-and-dump/Singletons/Classes2.golden b/tests/compile-and-dump/Singletons/Classes2.golden index 726fd576..cd4bea59 100644 --- a/tests/compile-and-dump/Singletons/Classes2.golden +++ b/tests/compile-and-dump/Singletons/Classes2.golden @@ -15,8 +15,6 @@ Singletons/Classes2.hs:(0,0)-(0,0): Splicing declarations mycompare (SuccFoo _) ZeroFoo = GT mycompare (SuccFoo n) (SuccFoo m) = (m `mycompare` n) type ZeroFooSym0 = ZeroFoo - type SuccFooSym1 (t0123456789876543210 :: NatFoo) = - SuccFoo t0123456789876543210 instance SuppressUnusedWarnings SuccFooSym0 where suppressUnusedWarnings = snd (((,) SuccFooSym0KindInference) ()) data SuccFooSym0 :: (~>) NatFoo NatFoo @@ -25,13 +23,22 @@ Singletons/Classes2.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply SuccFooSym0 arg) (SuccFooSym1 arg) => SuccFooSym0 t0123456789876543210 type instance Apply SuccFooSym0 t0123456789876543210 = SuccFooSym1 t0123456789876543210 + type SuccFooSym1 (t0123456789876543210 :: NatFoo) = + SuccFoo t0123456789876543210 type family Mycompare_0123456789876543210 (a :: NatFoo) (a :: NatFoo) :: Ordering where Mycompare_0123456789876543210 ZeroFoo ZeroFoo = EQSym0 Mycompare_0123456789876543210 ZeroFoo (SuccFoo _) = LTSym0 Mycompare_0123456789876543210 (SuccFoo _) ZeroFoo = GTSym0 Mycompare_0123456789876543210 (SuccFoo n) (SuccFoo m) = Apply (Apply MycompareSym0 m) n - type Mycompare_0123456789876543210Sym2 (a0123456789876543210 :: NatFoo) (a0123456789876543210 :: NatFoo) = - Mycompare_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Mycompare_0123456789876543210Sym0KindInference) ()) + data Mycompare_0123456789876543210Sym0 :: (~>) NatFoo ((~>) NatFoo Ordering) + where + Mycompare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) => + Mycompare_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Mycompare_0123456789876543210Sym0 a0123456789876543210 = Mycompare_0123456789876543210Sym1 a0123456789876543210 instance SuppressUnusedWarnings (Mycompare_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Mycompare_0123456789876543210Sym1KindInference) ()) @@ -42,15 +49,8 @@ Singletons/Classes2.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Mycompare_0123456789876543210Sym1 a0123456789876543210) arg) (Mycompare_0123456789876543210Sym2 a0123456789876543210 arg) => Mycompare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Mycompare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Mycompare_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd (((,) Mycompare_0123456789876543210Sym0KindInference) ()) - data Mycompare_0123456789876543210Sym0 :: (~>) NatFoo ((~>) NatFoo Ordering) - where - Mycompare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) => - Mycompare_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Mycompare_0123456789876543210Sym0 a0123456789876543210 = Mycompare_0123456789876543210Sym1 a0123456789876543210 + type Mycompare_0123456789876543210Sym2 (a0123456789876543210 :: NatFoo) (a0123456789876543210 :: NatFoo) = + Mycompare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance PMyOrd NatFoo where type Mycompare a a = Apply (Apply Mycompare_0123456789876543210Sym0 a) a data SNatFoo :: NatFoo -> GHC.Types.Type diff --git a/tests/compile-and-dump/Singletons/Contains.golden b/tests/compile-and-dump/Singletons/Contains.golden index 3786dbbf..eecbe254 100644 --- a/tests/compile-and-dump/Singletons/Contains.golden +++ b/tests/compile-and-dump/Singletons/Contains.golden @@ -7,17 +7,6 @@ Singletons/Contains.hs:(0,0)-(0,0): Splicing declarations contains :: Eq a => a -> [a] -> Bool contains _ [] = False contains elt (h : t) = ((elt == h) || (contains elt) t) - type ContainsSym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: [a0123456789876543210]) = - Contains a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (ContainsSym1 a0123456789876543210) where - suppressUnusedWarnings = snd (((,) ContainsSym1KindInference) ()) - data ContainsSym1 (a0123456789876543210 :: a0123456789876543210) :: (~>) [a0123456789876543210] Bool - where - ContainsSym1KindInference :: forall a0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply (ContainsSym1 a0123456789876543210) arg) (ContainsSym2 a0123456789876543210 arg) => - ContainsSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (ContainsSym1 a0123456789876543210) a0123456789876543210 = ContainsSym2 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings ContainsSym0 where suppressUnusedWarnings = snd (((,) ContainsSym0KindInference) ()) data ContainsSym0 :: forall a0123456789876543210. @@ -27,6 +16,17 @@ Singletons/Contains.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply ContainsSym0 arg) (ContainsSym1 arg) => ContainsSym0 a0123456789876543210 type instance Apply ContainsSym0 a0123456789876543210 = ContainsSym1 a0123456789876543210 + instance SuppressUnusedWarnings (ContainsSym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) ContainsSym1KindInference) ()) + data ContainsSym1 (a0123456789876543210 :: a0123456789876543210) :: (~>) [a0123456789876543210] Bool + where + ContainsSym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ContainsSym1 a0123456789876543210) arg) (ContainsSym2 a0123456789876543210 arg) => + ContainsSym1 a0123456789876543210 a0123456789876543210 + type instance Apply (ContainsSym1 a0123456789876543210) a0123456789876543210 = ContainsSym2 a0123456789876543210 a0123456789876543210 + type ContainsSym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: [a0123456789876543210]) = + Contains a0123456789876543210 a0123456789876543210 type family Contains (a :: a) (a :: [a]) :: Bool where Contains _ '[] = FalseSym0 Contains elt ('(:) h t) = Apply (Apply (||@#@$) (Apply (Apply (==@#@$) elt) h)) (Apply (Apply ContainsSym0 elt) t) diff --git a/tests/compile-and-dump/Singletons/DataValues.golden b/tests/compile-and-dump/Singletons/DataValues.golden index e1b6c2ea..9bad37c6 100644 --- a/tests/compile-and-dump/Singletons/DataValues.golden +++ b/tests/compile-and-dump/Singletons/DataValues.golden @@ -16,8 +16,15 @@ Singletons/DataValues.hs:(0,0)-(0,0): Splicing declarations complex = (Pair ((Pair (Just Zero)) Zero)) False tuple = (False, Just Zero, True) aList = [Zero, Succ Zero, Succ (Succ Zero)] - type PairSym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) = - Pair t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings PairSym0 where + suppressUnusedWarnings = snd (((,) PairSym0KindInference) ()) + data PairSym0 :: forall a0123456789876543210 b0123456789876543210. + (~>) a0123456789876543210 ((~>) b0123456789876543210 (Pair a0123456789876543210 b0123456789876543210)) + where + PairSym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply PairSym0 arg) (PairSym1 arg) => + PairSym0 t0123456789876543210 + type instance Apply PairSym0 t0123456789876543210 = PairSym1 t0123456789876543210 instance SuppressUnusedWarnings (PairSym1 t0123456789876543210) where suppressUnusedWarnings = snd (((,) PairSym1KindInference) ()) data PairSym1 (t0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. @@ -28,15 +35,8 @@ Singletons/DataValues.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (PairSym1 t0123456789876543210) arg) (PairSym2 t0123456789876543210 arg) => PairSym1 t0123456789876543210 t0123456789876543210 type instance Apply (PairSym1 t0123456789876543210) t0123456789876543210 = PairSym2 t0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings PairSym0 where - suppressUnusedWarnings = snd (((,) PairSym0KindInference) ()) - data PairSym0 :: forall a0123456789876543210 b0123456789876543210. - (~>) a0123456789876543210 ((~>) b0123456789876543210 (Pair a0123456789876543210 b0123456789876543210)) - where - PairSym0KindInference :: forall t0123456789876543210 - arg. SameKind (Apply PairSym0 arg) (PairSym1 arg) => - PairSym0 t0123456789876543210 - type instance Apply PairSym0 t0123456789876543210 = PairSym1 t0123456789876543210 + type PairSym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) = + Pair t0123456789876543210 t0123456789876543210 type AListSym0 = AList type TupleSym0 = Tuple type ComplexSym0 = Complex @@ -51,19 +51,17 @@ Singletons/DataValues.hs:(0,0)-(0,0): Splicing declarations Pr = Apply (Apply PairSym0 (Apply SuccSym0 ZeroSym0)) (Apply (Apply (:@#@$) ZeroSym0) '[]) type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Pair a b) (a :: Symbol) :: Symbol where ShowsPrec_0123456789876543210 p_0123456789876543210 (Pair arg_0123456789876543210 arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "Pair ")) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210)) (Apply (Apply (.@#@$) ShowSpaceSym0) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210))))) a_0123456789876543210 - type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Pair a0123456789876543210 b0123456789876543210) (a0123456789876543210 :: Symbol) = - ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where suppressUnusedWarnings - = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) - data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Pair a0123456789876543210 b0123456789876543210) :: (~>) Symbol Symbol + = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) + data ShowsPrec_0123456789876543210Sym0 :: forall a0123456789876543210 + b0123456789876543210. + (~>) GHC.Types.Nat ((~>) (Pair a0123456789876543210 b0123456789876543210) ((~>) Symbol Symbol)) where - ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 - a0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => - ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 - type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 + ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => + ShowsPrec_0123456789876543210Sym0 a0123456789876543210 + type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ()) @@ -76,17 +74,19 @@ Singletons/DataValues.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) => ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where + instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where suppressUnusedWarnings - = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) - data ShowsPrec_0123456789876543210Sym0 :: forall a0123456789876543210 - b0123456789876543210. - (~>) GHC.Types.Nat ((~>) (Pair a0123456789876543210 b0123456789876543210) ((~>) Symbol Symbol)) + = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) + data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Pair a0123456789876543210 b0123456789876543210) :: (~>) Symbol Symbol where - ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => - ShowsPrec_0123456789876543210Sym0 a0123456789876543210 - type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 + ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 + a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => + ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Pair a0123456789876543210 b0123456789876543210) (a0123456789876543210 :: Symbol) = + ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance PShow (Pair a b) where type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a sAList :: Sing AListSym0 diff --git a/tests/compile-and-dump/Singletons/EmptyShowDeriving.golden b/tests/compile-and-dump/Singletons/EmptyShowDeriving.golden index f47e5042..f34c1ce1 100644 --- a/tests/compile-and-dump/Singletons/EmptyShowDeriving.golden +++ b/tests/compile-and-dump/Singletons/EmptyShowDeriving.golden @@ -9,19 +9,15 @@ Singletons/EmptyShowDeriving.hs:(0,0)-(0,0): Splicing declarations type family Case_0123456789876543210 v_0123456789876543210 a_0123456789876543210 t where type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Foo) (a :: GHC.Types.Symbol) :: GHC.Types.Symbol where ShowsPrec_0123456789876543210 _ v_0123456789876543210 a_0123456789876543210 = Apply (Case_0123456789876543210 v_0123456789876543210 a_0123456789876543210 v_0123456789876543210) a_0123456789876543210 - type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Foo) (a0123456789876543210 :: GHC.Types.Symbol) = - ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where suppressUnusedWarnings - = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) - data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Foo) :: (~>) GHC.Types.Symbol GHC.Types.Symbol + = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) + data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Types.Nat ((~>) Foo ((~>) GHC.Types.Symbol GHC.Types.Symbol)) where - ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 - a0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => - ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 - type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 + ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => + ShowsPrec_0123456789876543210Sym0 a0123456789876543210 + type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ()) @@ -32,15 +28,19 @@ Singletons/EmptyShowDeriving.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) => ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where + instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where suppressUnusedWarnings - = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) - data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Types.Nat ((~>) Foo ((~>) GHC.Types.Symbol GHC.Types.Symbol)) + = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) + data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Foo) :: (~>) GHC.Types.Symbol GHC.Types.Symbol where - ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => - ShowsPrec_0123456789876543210Sym0 a0123456789876543210 - type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 + ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 + a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => + ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Foo) (a0123456789876543210 :: GHC.Types.Symbol) = + ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance PShow Foo where type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a data SFoo :: Foo -> GHC.Types.Type diff --git a/tests/compile-and-dump/Singletons/EnumDeriving.golden b/tests/compile-and-dump/Singletons/EnumDeriving.golden index 762ab961..b4ae5261 100644 --- a/tests/compile-and-dump/Singletons/EnumDeriving.golden +++ b/tests/compile-and-dump/Singletons/EnumDeriving.golden @@ -25,8 +25,6 @@ Singletons/EnumDeriving.hs:(0,0)-(0,0): Splicing declarations Case_0123456789876543210 n 'False = Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 1)) type family ToEnum_0123456789876543210 (a :: GHC.Types.Nat) :: Foo where ToEnum_0123456789876543210 n = Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 0)) - type ToEnum_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) = - ToEnum_0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings ToEnum_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) ToEnum_0123456789876543210Sym0KindInference) ()) @@ -36,12 +34,12 @@ Singletons/EnumDeriving.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply ToEnum_0123456789876543210Sym0 arg) (ToEnum_0123456789876543210Sym1 arg) => ToEnum_0123456789876543210Sym0 a0123456789876543210 type instance Apply ToEnum_0123456789876543210Sym0 a0123456789876543210 = ToEnum_0123456789876543210Sym1 a0123456789876543210 + type ToEnum_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) = + ToEnum_0123456789876543210 a0123456789876543210 type family FromEnum_0123456789876543210 (a :: Foo) :: GHC.Types.Nat where FromEnum_0123456789876543210 Bar = Data.Singletons.Prelude.Num.FromInteger 0 FromEnum_0123456789876543210 Baz = Data.Singletons.Prelude.Num.FromInteger 1 FromEnum_0123456789876543210 Bum = Data.Singletons.Prelude.Num.FromInteger 2 - type FromEnum_0123456789876543210Sym1 (a0123456789876543210 :: Foo) = - FromEnum_0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings FromEnum_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) FromEnum_0123456789876543210Sym0KindInference) ()) @@ -51,6 +49,8 @@ Singletons/EnumDeriving.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply FromEnum_0123456789876543210Sym0 arg) (FromEnum_0123456789876543210Sym1 arg) => FromEnum_0123456789876543210Sym0 a0123456789876543210 type instance Apply FromEnum_0123456789876543210Sym0 a0123456789876543210 = FromEnum_0123456789876543210Sym1 a0123456789876543210 + type FromEnum_0123456789876543210Sym1 (a0123456789876543210 :: Foo) = + FromEnum_0123456789876543210 a0123456789876543210 instance PEnum Foo where type ToEnum a = Apply ToEnum_0123456789876543210Sym0 a type FromEnum a = Apply FromEnum_0123456789876543210Sym0 a @@ -142,8 +142,6 @@ Singletons/EnumDeriving.hs:0:0:: Splicing declarations Case_0123456789876543210 n 'False = Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 1)) type family ToEnum_0123456789876543210 (a :: GHC.Types.Nat) :: Quux where ToEnum_0123456789876543210 n = Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 0)) - type ToEnum_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) = - ToEnum_0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings ToEnum_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) ToEnum_0123456789876543210Sym0KindInference) ()) @@ -153,11 +151,11 @@ Singletons/EnumDeriving.hs:0:0:: Splicing declarations arg. SameKind (Apply ToEnum_0123456789876543210Sym0 arg) (ToEnum_0123456789876543210Sym1 arg) => ToEnum_0123456789876543210Sym0 a0123456789876543210 type instance Apply ToEnum_0123456789876543210Sym0 a0123456789876543210 = ToEnum_0123456789876543210Sym1 a0123456789876543210 + type ToEnum_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) = + ToEnum_0123456789876543210 a0123456789876543210 type family FromEnum_0123456789876543210 (a :: Quux) :: GHC.Types.Nat where FromEnum_0123456789876543210 'Q1 = Data.Singletons.Prelude.Num.FromInteger 0 FromEnum_0123456789876543210 'Q2 = Data.Singletons.Prelude.Num.FromInteger 1 - type FromEnum_0123456789876543210Sym1 (a0123456789876543210 :: Quux) = - FromEnum_0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings FromEnum_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) FromEnum_0123456789876543210Sym0KindInference) ()) @@ -167,6 +165,8 @@ Singletons/EnumDeriving.hs:0:0:: Splicing declarations arg. SameKind (Apply FromEnum_0123456789876543210Sym0 arg) (FromEnum_0123456789876543210Sym1 arg) => FromEnum_0123456789876543210Sym0 a0123456789876543210 type instance Apply FromEnum_0123456789876543210Sym0 a0123456789876543210 = FromEnum_0123456789876543210Sym1 a0123456789876543210 + type FromEnum_0123456789876543210Sym1 (a0123456789876543210 :: Quux) = + FromEnum_0123456789876543210 a0123456789876543210 instance PEnum Quux where type ToEnum a = Apply ToEnum_0123456789876543210Sym0 a type FromEnum a = Apply FromEnum_0123456789876543210Sym0 a diff --git a/tests/compile-and-dump/Singletons/Error.golden b/tests/compile-and-dump/Singletons/Error.golden index 62d57ec5..ab79e75e 100644 --- a/tests/compile-and-dump/Singletons/Error.golden +++ b/tests/compile-and-dump/Singletons/Error.golden @@ -7,8 +7,6 @@ Singletons/Error.hs:(0,0)-(0,0): Splicing declarations head :: [a] -> a head (a : _) = a head [] = error "Data.Singletons.List.head: empty list" - type HeadSym1 (a0123456789876543210 :: [a0123456789876543210]) = - Head a0123456789876543210 instance SuppressUnusedWarnings HeadSym0 where suppressUnusedWarnings = snd (((,) HeadSym0KindInference) ()) data HeadSym0 :: forall a0123456789876543210. @@ -18,6 +16,8 @@ Singletons/Error.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply HeadSym0 arg) (HeadSym1 arg) => HeadSym0 a0123456789876543210 type instance Apply HeadSym0 a0123456789876543210 = HeadSym1 a0123456789876543210 + type HeadSym1 (a0123456789876543210 :: [a0123456789876543210]) = + Head a0123456789876543210 type family Head (a :: [a]) :: a where Head ('(:) a _) = a Head '[] = Apply ErrorSym0 "Data.Singletons.List.head: empty list" diff --git a/tests/compile-and-dump/Singletons/Fixity.golden b/tests/compile-and-dump/Singletons/Fixity.golden index 53e4b904..d4be1ecb 100644 --- a/tests/compile-and-dump/Singletons/Fixity.golden +++ b/tests/compile-and-dump/Singletons/Fixity.golden @@ -16,19 +16,6 @@ Singletons/Fixity.hs:(0,0)-(0,0): Splicing declarations (====) :: a -> a -> a (====) a _ = a infix 4 ==== - type (====@#@$$$) (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: a0123456789876543210) = - (====) a0123456789876543210 a0123456789876543210 - infix 4 ====@#@$$$ - instance SuppressUnusedWarnings ((====@#@$$) a0123456789876543210) where - suppressUnusedWarnings = snd (((,) (:====@#@$$###)) ()) - data (====@#@$$) (a0123456789876543210 :: a0123456789876543210) :: (~>) a0123456789876543210 a0123456789876543210 - where - (:====@#@$$###) :: forall a0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply ((====@#@$$) a0123456789876543210) arg) ((====@#@$$$) a0123456789876543210 arg) => - (====@#@$$) a0123456789876543210 a0123456789876543210 - type instance Apply ((====@#@$$) a0123456789876543210) a0123456789876543210 = (====@#@$$$) a0123456789876543210 a0123456789876543210 - infix 4 ====@#@$$ instance SuppressUnusedWarnings (====@#@$) where suppressUnusedWarnings = snd (((,) (:====@#@$###)) ()) data (====@#@$) :: forall a0123456789876543210. @@ -39,21 +26,21 @@ Singletons/Fixity.hs:(0,0)-(0,0): Splicing declarations (====@#@$) a0123456789876543210 type instance Apply (====@#@$) a0123456789876543210 = (====@#@$$) a0123456789876543210 infix 4 ====@#@$ + instance SuppressUnusedWarnings ((====@#@$$) a0123456789876543210) where + suppressUnusedWarnings = snd (((,) (:====@#@$$###)) ()) + data (====@#@$$) (a0123456789876543210 :: a0123456789876543210) :: (~>) a0123456789876543210 a0123456789876543210 + where + (:====@#@$$###) :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply ((====@#@$$) a0123456789876543210) arg) ((====@#@$$$) a0123456789876543210 arg) => + (====@#@$$) a0123456789876543210 a0123456789876543210 + type instance Apply ((====@#@$$) a0123456789876543210) a0123456789876543210 = (====@#@$$$) a0123456789876543210 a0123456789876543210 + infix 4 ====@#@$$ + type (====@#@$$$) (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: a0123456789876543210) = + (====) a0123456789876543210 a0123456789876543210 + infix 4 ====@#@$$$ type family (====) (a :: a) (a :: a) :: a where (====) a _ = a - type (<=>@#@$$$) (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: a0123456789876543210) = - (<=>) arg0123456789876543210 arg0123456789876543210 - infix 4 <=>@#@$$$ - instance SuppressUnusedWarnings ((<=>@#@$$) arg0123456789876543210) where - suppressUnusedWarnings = snd (((,) (:<=>@#@$$###)) ()) - data (<=>@#@$$) (arg0123456789876543210 :: a0123456789876543210) :: (~>) a0123456789876543210 Ordering - where - (:<=>@#@$$###) :: forall arg0123456789876543210 - arg0123456789876543210 - arg. SameKind (Apply ((<=>@#@$$) arg0123456789876543210) arg) ((<=>@#@$$$) arg0123456789876543210 arg) => - (<=>@#@$$) arg0123456789876543210 arg0123456789876543210 - type instance Apply ((<=>@#@$$) arg0123456789876543210) arg0123456789876543210 = (<=>@#@$$$) arg0123456789876543210 arg0123456789876543210 - infix 4 <=>@#@$$ instance SuppressUnusedWarnings (<=>@#@$) where suppressUnusedWarnings = snd (((,) (:<=>@#@$###)) ()) data (<=>@#@$) :: forall a0123456789876543210. @@ -64,6 +51,19 @@ Singletons/Fixity.hs:(0,0)-(0,0): Splicing declarations (<=>@#@$) arg0123456789876543210 type instance Apply (<=>@#@$) arg0123456789876543210 = (<=>@#@$$) arg0123456789876543210 infix 4 <=>@#@$ + instance SuppressUnusedWarnings ((<=>@#@$$) arg0123456789876543210) where + suppressUnusedWarnings = snd (((,) (:<=>@#@$$###)) ()) + data (<=>@#@$$) (arg0123456789876543210 :: a0123456789876543210) :: (~>) a0123456789876543210 Ordering + where + (:<=>@#@$$###) :: forall arg0123456789876543210 + arg0123456789876543210 + arg. SameKind (Apply ((<=>@#@$$) arg0123456789876543210) arg) ((<=>@#@$$$) arg0123456789876543210 arg) => + (<=>@#@$$) arg0123456789876543210 arg0123456789876543210 + type instance Apply ((<=>@#@$$) arg0123456789876543210) arg0123456789876543210 = (<=>@#@$$$) arg0123456789876543210 arg0123456789876543210 + infix 4 <=>@#@$$ + type (<=>@#@$$$) (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: a0123456789876543210) = + (<=>) arg0123456789876543210 arg0123456789876543210 + infix 4 <=>@#@$$$ class PMyOrd a where type (<=>) (arg :: a) (arg :: a) :: Ordering infix 4 %==== diff --git a/tests/compile-and-dump/Singletons/FunDeps.golden b/tests/compile-and-dump/Singletons/FunDeps.golden index 794e6589..a09b68be 100644 --- a/tests/compile-and-dump/Singletons/FunDeps.golden +++ b/tests/compile-and-dump/Singletons/FunDeps.golden @@ -22,8 +22,6 @@ Singletons/FunDeps.hs:(0,0)-(0,0): Splicing declarations type T1Sym0 = T1 type family T1 where T1 = Apply MethSym0 TrueSym0 - type MethSym1 (arg0123456789876543210 :: a0123456789876543210) = - Meth arg0123456789876543210 instance SuppressUnusedWarnings MethSym0 where suppressUnusedWarnings = snd (((,) MethSym0KindInference) ()) data MethSym0 :: forall a0123456789876543210. @@ -33,8 +31,8 @@ Singletons/FunDeps.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply MethSym0 arg) (MethSym1 arg) => MethSym0 arg0123456789876543210 type instance Apply MethSym0 arg0123456789876543210 = MethSym1 arg0123456789876543210 - type L2rSym1 (arg0123456789876543210 :: a0123456789876543210) = - L2r arg0123456789876543210 + type MethSym1 (arg0123456789876543210 :: a0123456789876543210) = + Meth arg0123456789876543210 instance SuppressUnusedWarnings L2rSym0 where suppressUnusedWarnings = snd (((,) L2rSym0KindInference) ()) data L2rSym0 :: forall a0123456789876543210 b0123456789876543210. @@ -44,13 +42,13 @@ Singletons/FunDeps.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply L2rSym0 arg) (L2rSym1 arg) => L2rSym0 arg0123456789876543210 type instance Apply L2rSym0 arg0123456789876543210 = L2rSym1 arg0123456789876543210 + type L2rSym1 (arg0123456789876543210 :: a0123456789876543210) = + L2r arg0123456789876543210 class PFD a b | a -> b where type Meth (arg :: a) :: a type L2r (arg :: a) :: b type family Meth_0123456789876543210 (a :: Bool) :: Bool where Meth_0123456789876543210 a_0123456789876543210 = Apply NotSym0 a_0123456789876543210 - type Meth_0123456789876543210Sym1 (a0123456789876543210 :: Bool) = - Meth_0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Meth_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Meth_0123456789876543210Sym0KindInference) ()) @@ -60,11 +58,11 @@ Singletons/FunDeps.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Meth_0123456789876543210Sym0 arg) (Meth_0123456789876543210Sym1 arg) => Meth_0123456789876543210Sym0 a0123456789876543210 type instance Apply Meth_0123456789876543210Sym0 a0123456789876543210 = Meth_0123456789876543210Sym1 a0123456789876543210 + type Meth_0123456789876543210Sym1 (a0123456789876543210 :: Bool) = + Meth_0123456789876543210 a0123456789876543210 type family L2r_0123456789876543210 (a :: Bool) :: Nat where L2r_0123456789876543210 'False = FromInteger 0 L2r_0123456789876543210 'True = FromInteger 1 - type L2r_0123456789876543210Sym1 (a0123456789876543210 :: Bool) = - L2r_0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings L2r_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) L2r_0123456789876543210Sym0KindInference) ()) @@ -74,6 +72,8 @@ Singletons/FunDeps.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply L2r_0123456789876543210Sym0 arg) (L2r_0123456789876543210Sym1 arg) => L2r_0123456789876543210Sym0 a0123456789876543210 type instance Apply L2r_0123456789876543210Sym0 a0123456789876543210 = L2r_0123456789876543210Sym1 a0123456789876543210 + type L2r_0123456789876543210Sym1 (a0123456789876543210 :: Bool) = + L2r_0123456789876543210 a0123456789876543210 instance PFD Bool Nat where type Meth a = Apply Meth_0123456789876543210Sym0 a type L2r a = Apply L2r_0123456789876543210Sym0 a diff --git a/tests/compile-and-dump/Singletons/FunctorLikeDeriving.golden b/tests/compile-and-dump/Singletons/FunctorLikeDeriving.golden index 023b7806..f3a9971d 100644 --- a/tests/compile-and-dump/Singletons/FunctorLikeDeriving.golden +++ b/tests/compile-and-dump/Singletons/FunctorLikeDeriving.golden @@ -9,19 +9,25 @@ Singletons/FunctorLikeDeriving.hs:(0,0)-(0,0): Splicing declarations = MkT1 x a (Maybe a) (Maybe (Maybe a)) | MkT2 (Maybe x) deriving (Functor, Foldable, Traversable) data Empty (a :: Type) deriving (Functor, Foldable, Traversable) - type MkT1Sym4 (t0123456789876543210 :: x0123456789876543210) (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: Maybe a0123456789876543210) (t0123456789876543210 :: Maybe (Maybe a0123456789876543210)) = - MkT1 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (MkT1Sym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) where - suppressUnusedWarnings = snd (((,) MkT1Sym3KindInference) ()) - data MkT1Sym3 (t0123456789876543210 :: x0123456789876543210) (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: Maybe a0123456789876543210) :: (~>) (Maybe (Maybe a0123456789876543210)) (T x0123456789876543210 a0123456789876543210) + instance SuppressUnusedWarnings MkT1Sym0 where + suppressUnusedWarnings = snd (((,) MkT1Sym0KindInference) ()) + data MkT1Sym0 :: forall x0123456789876543210 a0123456789876543210. + (~>) x0123456789876543210 ((~>) a0123456789876543210 ((~>) (Maybe a0123456789876543210) ((~>) (Maybe (Maybe a0123456789876543210)) (T x0123456789876543210 a0123456789876543210)))) where - MkT1Sym3KindInference :: forall t0123456789876543210 - t0123456789876543210 - t0123456789876543210 + MkT1Sym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply MkT1Sym0 arg) (MkT1Sym1 arg) => + MkT1Sym0 t0123456789876543210 + type instance Apply MkT1Sym0 t0123456789876543210 = MkT1Sym1 t0123456789876543210 + instance SuppressUnusedWarnings (MkT1Sym1 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) MkT1Sym1KindInference) ()) + data MkT1Sym1 (t0123456789876543210 :: x0123456789876543210) :: forall a0123456789876543210. + (~>) a0123456789876543210 ((~>) (Maybe a0123456789876543210) ((~>) (Maybe (Maybe a0123456789876543210)) (T x0123456789876543210 a0123456789876543210))) + where + MkT1Sym1KindInference :: forall t0123456789876543210 t0123456789876543210 - arg. SameKind (Apply (MkT1Sym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) arg) (MkT1Sym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 arg) => - MkT1Sym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 - type instance Apply (MkT1Sym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) t0123456789876543210 = MkT1Sym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 + arg. SameKind (Apply (MkT1Sym1 t0123456789876543210) arg) (MkT1Sym2 t0123456789876543210 arg) => + MkT1Sym1 t0123456789876543210 t0123456789876543210 + type instance Apply (MkT1Sym1 t0123456789876543210) t0123456789876543210 = MkT1Sym2 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (MkT1Sym2 t0123456789876543210 t0123456789876543210) where suppressUnusedWarnings = snd (((,) MkT1Sym2KindInference) ()) data MkT1Sym2 (t0123456789876543210 :: x0123456789876543210) (t0123456789876543210 :: a0123456789876543210) :: (~>) (Maybe a0123456789876543210) ((~>) (Maybe (Maybe a0123456789876543210)) (T x0123456789876543210 a0123456789876543210)) @@ -32,27 +38,19 @@ Singletons/FunctorLikeDeriving.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (MkT1Sym2 t0123456789876543210 t0123456789876543210) arg) (MkT1Sym3 t0123456789876543210 t0123456789876543210 arg) => MkT1Sym2 t0123456789876543210 t0123456789876543210 t0123456789876543210 type instance Apply (MkT1Sym2 t0123456789876543210 t0123456789876543210) t0123456789876543210 = MkT1Sym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (MkT1Sym1 t0123456789876543210) where - suppressUnusedWarnings = snd (((,) MkT1Sym1KindInference) ()) - data MkT1Sym1 (t0123456789876543210 :: x0123456789876543210) :: forall a0123456789876543210. - (~>) a0123456789876543210 ((~>) (Maybe a0123456789876543210) ((~>) (Maybe (Maybe a0123456789876543210)) (T x0123456789876543210 a0123456789876543210))) + instance SuppressUnusedWarnings (MkT1Sym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) MkT1Sym3KindInference) ()) + data MkT1Sym3 (t0123456789876543210 :: x0123456789876543210) (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: Maybe a0123456789876543210) :: (~>) (Maybe (Maybe a0123456789876543210)) (T x0123456789876543210 a0123456789876543210) where - MkT1Sym1KindInference :: forall t0123456789876543210 + MkT1Sym3KindInference :: forall t0123456789876543210 t0123456789876543210 - arg. SameKind (Apply (MkT1Sym1 t0123456789876543210) arg) (MkT1Sym2 t0123456789876543210 arg) => - MkT1Sym1 t0123456789876543210 t0123456789876543210 - type instance Apply (MkT1Sym1 t0123456789876543210) t0123456789876543210 = MkT1Sym2 t0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings MkT1Sym0 where - suppressUnusedWarnings = snd (((,) MkT1Sym0KindInference) ()) - data MkT1Sym0 :: forall x0123456789876543210 a0123456789876543210. - (~>) x0123456789876543210 ((~>) a0123456789876543210 ((~>) (Maybe a0123456789876543210) ((~>) (Maybe (Maybe a0123456789876543210)) (T x0123456789876543210 a0123456789876543210)))) - where - MkT1Sym0KindInference :: forall t0123456789876543210 - arg. SameKind (Apply MkT1Sym0 arg) (MkT1Sym1 arg) => - MkT1Sym0 t0123456789876543210 - type instance Apply MkT1Sym0 t0123456789876543210 = MkT1Sym1 t0123456789876543210 - type MkT2Sym1 (t0123456789876543210 :: Maybe x0123456789876543210) = - MkT2 t0123456789876543210 + t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (MkT1Sym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) arg) (MkT1Sym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 arg) => + MkT1Sym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 + type instance Apply (MkT1Sym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) t0123456789876543210 = MkT1Sym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 + type MkT1Sym4 (t0123456789876543210 :: x0123456789876543210) (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: Maybe a0123456789876543210) (t0123456789876543210 :: Maybe (Maybe a0123456789876543210)) = + MkT1 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings MkT2Sym0 where suppressUnusedWarnings = snd (((,) MkT2Sym0KindInference) ()) data MkT2Sym0 :: forall x0123456789876543210 a0123456789876543210. @@ -62,38 +60,41 @@ Singletons/FunctorLikeDeriving.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply MkT2Sym0 arg) (MkT2Sym1 arg) => MkT2Sym0 t0123456789876543210 type instance Apply MkT2Sym0 t0123456789876543210 = MkT2Sym1 t0123456789876543210 + type MkT2Sym1 (t0123456789876543210 :: Maybe x0123456789876543210) = + MkT2 t0123456789876543210 type family Lambda_0123456789876543210 _f_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 t where Lambda_0123456789876543210 _f_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n_0123456789876543210 = n_0123456789876543210 - type Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 = - Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym5KindInference) ()) - data Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym5KindInference :: forall _f_01234567898765432100123456789876543210 - a_01234567898765432100123456789876543210 - a_01234567898765432100123456789876543210 - a_01234567898765432100123456789876543210 - a_01234567898765432100123456789876543210 - t0123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym6 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + Lambda_0123456789876543210Sym0KindInference :: forall _f_01234567898765432100123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym4KindInference) ()) - data Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) + data Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym4KindInference :: forall _f_01234567898765432100123456789876543210 - a_01234567898765432100123456789876543210 + Lambda_0123456789876543210Sym1KindInference :: forall _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym2KindInference :: forall _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) data Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 @@ -104,28 +105,38 @@ Singletons/FunctorLikeDeriving.hs:(0,0)-(0,0): Splicing declarations a_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + type instance Apply (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) - data Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym4KindInference) ()) + data Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym2KindInference :: forall _f_01234567898765432100123456789876543210 + Lambda_0123456789876543210Sym4KindInference :: forall _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) where + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) - data Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym5KindInference) ()) + data Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 where - Lambda_0123456789876543210Sym1KindInference :: forall _f_01234567898765432100123456789876543210 + Lambda_0123456789876543210Sym5KindInference :: forall _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + type Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + type family Lambda_0123456789876543210 _f_0123456789876543210 a_0123456789876543210 t where + Lambda_0123456789876543210 _f_0123456789876543210 a_0123456789876543210 n_0123456789876543210 = n_0123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) @@ -135,21 +146,6 @@ Singletons/FunctorLikeDeriving.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 - type family Lambda_0123456789876543210 _f_0123456789876543210 a_0123456789876543210 t where - Lambda_0123456789876543210 _f_0123456789876543210 a_0123456789876543210 n_0123456789876543210 = n_0123456789876543210 - type Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 = - Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) - data Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 - where - Lambda_0123456789876543210Sym2KindInference :: forall _f_01234567898765432100123456789876543210 - a_01234567898765432100123456789876543210 - t0123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) @@ -160,31 +156,22 @@ Singletons/FunctorLikeDeriving.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) - data Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 where - Lambda_0123456789876543210Sym0KindInference :: forall _f_01234567898765432100123456789876543210 - arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 + Lambda_0123456789876543210Sym2KindInference :: forall _f_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + type Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 type family Fmap_0123456789876543210 (a :: (~>) a0123456789876543210 b0123456789876543210) (a :: T x a0123456789876543210) :: T x b0123456789876543210 where Fmap_0123456789876543210 _f_0123456789876543210 (MkT1 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) = Apply (Apply (Apply (Apply MkT1Sym0 (Apply (Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210)) (Apply _f_0123456789876543210 a_0123456789876543210)) (Apply (Apply FmapSym0 _f_0123456789876543210) a_0123456789876543210)) (Apply (Apply FmapSym0 (Apply FmapSym0 _f_0123456789876543210)) a_0123456789876543210) Fmap_0123456789876543210 _f_0123456789876543210 (MkT2 a_0123456789876543210) = Apply MkT2Sym0 (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) a_0123456789876543210) a_0123456789876543210) - type Fmap_0123456789876543210Sym2 (a0123456789876543210 :: (~>) a01234567898765432100123456789876543210 b01234567898765432100123456789876543210) (a0123456789876543210 :: T x0123456789876543210 a01234567898765432100123456789876543210) = - Fmap_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (Fmap_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd (((,) Fmap_0123456789876543210Sym1KindInference) ()) - data Fmap_0123456789876543210Sym1 (a0123456789876543210 :: (~>) a01234567898765432100123456789876543210 b01234567898765432100123456789876543210) :: forall x0123456789876543210. - (~>) (T x0123456789876543210 a01234567898765432100123456789876543210) (T x0123456789876543210 b01234567898765432100123456789876543210) - where - Fmap_0123456789876543210Sym1KindInference :: forall a0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply (Fmap_0123456789876543210Sym1 a0123456789876543210) arg) (Fmap_0123456789876543210Sym2 a0123456789876543210 arg) => - Fmap_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 - type instance Apply (Fmap_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Fmap_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Fmap_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Fmap_0123456789876543210Sym0KindInference) ()) @@ -197,25 +184,64 @@ Singletons/FunctorLikeDeriving.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Fmap_0123456789876543210Sym0 arg) (Fmap_0123456789876543210Sym1 arg) => Fmap_0123456789876543210Sym0 a0123456789876543210 type instance Apply Fmap_0123456789876543210Sym0 a0123456789876543210 = Fmap_0123456789876543210Sym1 a0123456789876543210 + instance SuppressUnusedWarnings (Fmap_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Fmap_0123456789876543210Sym1KindInference) ()) + data Fmap_0123456789876543210Sym1 (a0123456789876543210 :: (~>) a01234567898765432100123456789876543210 b01234567898765432100123456789876543210) :: forall x0123456789876543210. + (~>) (T x0123456789876543210 a01234567898765432100123456789876543210) (T x0123456789876543210 b01234567898765432100123456789876543210) + where + Fmap_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Fmap_0123456789876543210Sym1 a0123456789876543210) arg) (Fmap_0123456789876543210Sym2 a0123456789876543210 arg) => + Fmap_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Fmap_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Fmap_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 + type Fmap_0123456789876543210Sym2 (a0123456789876543210 :: (~>) a01234567898765432100123456789876543210 b01234567898765432100123456789876543210) (a0123456789876543210 :: T x0123456789876543210 a01234567898765432100123456789876543210) = + Fmap_0123456789876543210 a0123456789876543210 a0123456789876543210 type family Lambda_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 t where Lambda_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n_0123456789876543210 = n_0123456789876543210 - type Lambda_0123456789876543210Sym6 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 = - Lambda_0123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) where + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym5KindInference) ()) - data Lambda_0123456789876543210Sym5 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 _z_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym5KindInference :: forall _z_01234567898765432100123456789876543210 + Lambda_0123456789876543210Sym0KindInference :: forall _z_01234567898765432100123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 _z_01234567898765432100123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 _z_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) + data Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym1KindInference :: forall _z_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym2KindInference :: forall _z_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) + data Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym3KindInference :: forall _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - t0123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym5 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym6 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym5 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym6 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) where + arg. SameKind (Apply (Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym4 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym4 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym4KindInference) ()) data Lambda_0123456789876543210Sym4 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 @@ -227,30 +253,34 @@ Singletons/FunctorLikeDeriving.hs:(0,0)-(0,0): Splicing declarations a_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym4 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym5 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym4 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) where + type instance Apply (Lambda_0123456789876543210Sym4 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym5 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym5 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) - data Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym5KindInference) ()) + data Lambda_0123456789876543210Sym5 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 where - Lambda_0123456789876543210Sym3KindInference :: forall _z_01234567898765432100123456789876543210 + Lambda_0123456789876543210Sym5KindInference :: forall _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym4 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) where + a_01234567898765432100123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym5 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym6 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym5 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym5 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym6 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + type Lambda_0123456789876543210Sym6 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + type family Lambda_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 t where + Lambda_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n_0123456789876543210 = _z_0123456789876543210 + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) - data Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 _z_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym2KindInference :: forall _z_01234567898765432100123456789876543210 - a_01234567898765432100123456789876543210 - a_01234567898765432100123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + Lambda_0123456789876543210Sym0KindInference :: forall _z_01234567898765432100123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 _z_01234567898765432100123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 _z_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) @@ -261,34 +291,30 @@ Singletons/FunctorLikeDeriving.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) - data Lambda_0123456789876543210Sym0 _z_01234567898765432100123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym0KindInference :: forall _z_01234567898765432100123456789876543210 - arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 _z_01234567898765432100123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 _z_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210 - type family Lambda_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 t where - Lambda_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n_0123456789876543210 = _z_0123456789876543210 - type Lambda_0123456789876543210Sym6 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 = - Lambda_0123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) where + Lambda_0123456789876543210Sym2KindInference :: forall _z_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym5KindInference) ()) - data Lambda_0123456789876543210Sym5 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) + data Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym5KindInference :: forall _z_01234567898765432100123456789876543210 - a_01234567898765432100123456789876543210 + Lambda_0123456789876543210Sym3KindInference :: forall _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - t0123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym5 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym6 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym5 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym6 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) where + arg. SameKind (Apply (Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym4 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym4 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym4KindInference) ()) data Lambda_0123456789876543210Sym4 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 @@ -300,40 +326,25 @@ Singletons/FunctorLikeDeriving.hs:(0,0)-(0,0): Splicing declarations a_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym4 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym5 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym4 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) where + type instance Apply (Lambda_0123456789876543210Sym4 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym5 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym5 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) - data Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym5KindInference) ()) + data Lambda_0123456789876543210Sym5 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 where - Lambda_0123456789876543210Sym3KindInference :: forall _z_01234567898765432100123456789876543210 - a_01234567898765432100123456789876543210 - a_01234567898765432100123456789876543210 + Lambda_0123456789876543210Sym5KindInference :: forall _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym4 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) - data Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym2KindInference :: forall _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) - data Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym1KindInference :: forall _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym5 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym6 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym5 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym5 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym6 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + type Lambda_0123456789876543210Sym6 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + type family Lambda_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 t where + Lambda_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 n_0123456789876543210 = n_0123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) @@ -343,21 +354,6 @@ Singletons/FunctorLikeDeriving.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 _z_01234567898765432100123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 _z_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210 - type family Lambda_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 t where - Lambda_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 n_0123456789876543210 = n_0123456789876543210 - type Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 = - Lambda_0123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) - data Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 - where - Lambda_0123456789876543210Sym2KindInference :: forall _z_01234567898765432100123456789876543210 - a_01234567898765432100123456789876543210 - t0123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) @@ -368,32 +364,22 @@ Singletons/FunctorLikeDeriving.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) - data Lambda_0123456789876543210Sym0 _z_01234567898765432100123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 where - Lambda_0123456789876543210Sym0KindInference :: forall _z_01234567898765432100123456789876543210 - arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 _z_01234567898765432100123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 _z_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210 + Lambda_0123456789876543210Sym2KindInference :: forall _z_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + type Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 type family TFHelper_0123456789876543210 (a :: a) (a :: T x b) :: T x a where TFHelper_0123456789876543210 _z_0123456789876543210 (MkT1 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) = Apply (Apply (Apply (Apply MkT1Sym0 (Apply (Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _z_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210)) (Apply (Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _z_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210)) (Apply (Apply (<$@#@$) _z_0123456789876543210) a_0123456789876543210)) (Apply (Apply FmapSym0 (Apply (<$@#@$) _z_0123456789876543210)) a_0123456789876543210) TFHelper_0123456789876543210 _z_0123456789876543210 (MkT2 a_0123456789876543210) = Apply MkT2Sym0 (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _z_0123456789876543210) a_0123456789876543210) a_0123456789876543210) - type TFHelper_0123456789876543210Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: T x0123456789876543210 b0123456789876543210) = - TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (TFHelper_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd (((,) TFHelper_0123456789876543210Sym1KindInference) ()) - data TFHelper_0123456789876543210Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall x0123456789876543210 - b0123456789876543210. - (~>) (T x0123456789876543210 b0123456789876543210) (T x0123456789876543210 a0123456789876543210) - where - TFHelper_0123456789876543210Sym1KindInference :: forall a0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply (TFHelper_0123456789876543210Sym1 a0123456789876543210) arg) (TFHelper_0123456789876543210Sym2 a0123456789876543210 arg) => - TFHelper_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 - type instance Apply (TFHelper_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = TFHelper_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) TFHelper_0123456789876543210Sym0KindInference) ()) @@ -406,41 +392,56 @@ Singletons/FunctorLikeDeriving.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply TFHelper_0123456789876543210Sym0 arg) (TFHelper_0123456789876543210Sym1 arg) => TFHelper_0123456789876543210Sym0 a0123456789876543210 type instance Apply TFHelper_0123456789876543210Sym0 a0123456789876543210 = TFHelper_0123456789876543210Sym1 a0123456789876543210 + instance SuppressUnusedWarnings (TFHelper_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) TFHelper_0123456789876543210Sym1KindInference) ()) + data TFHelper_0123456789876543210Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall x0123456789876543210 + b0123456789876543210. + (~>) (T x0123456789876543210 b0123456789876543210) (T x0123456789876543210 a0123456789876543210) + where + TFHelper_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (TFHelper_0123456789876543210Sym1 a0123456789876543210) arg) (TFHelper_0123456789876543210Sym2 a0123456789876543210 arg) => + TFHelper_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (TFHelper_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = TFHelper_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 + type TFHelper_0123456789876543210Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: T x0123456789876543210 b0123456789876543210) = + TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210 instance PFunctor (T x) where type Fmap a a = Apply (Apply Fmap_0123456789876543210Sym0 a) a type (<$) a a = Apply (Apply TFHelper_0123456789876543210Sym0 a) a type family Lambda_0123456789876543210 _f_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 t where Lambda_0123456789876543210 _f_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n_0123456789876543210 = MemptySym0 - type Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 = - Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym5KindInference) ()) - data Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym5KindInference :: forall _f_01234567898765432100123456789876543210 - a_01234567898765432100123456789876543210 - a_01234567898765432100123456789876543210 - a_01234567898765432100123456789876543210 - a_01234567898765432100123456789876543210 - t0123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym6 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + Lambda_0123456789876543210Sym0KindInference :: forall _f_01234567898765432100123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym4KindInference) ()) - data Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) + data Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym4KindInference :: forall _f_01234567898765432100123456789876543210 - a_01234567898765432100123456789876543210 + Lambda_0123456789876543210Sym1KindInference :: forall _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym2KindInference :: forall _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) data Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 @@ -451,28 +452,38 @@ Singletons/FunctorLikeDeriving.hs:(0,0)-(0,0): Splicing declarations a_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + type instance Apply (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) - data Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym4KindInference) ()) + data Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym2KindInference :: forall _f_01234567898765432100123456789876543210 + Lambda_0123456789876543210Sym4KindInference :: forall _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) where + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) - data Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym5KindInference) ()) + data Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 where - Lambda_0123456789876543210Sym1KindInference :: forall _f_01234567898765432100123456789876543210 + Lambda_0123456789876543210Sym5KindInference :: forall _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + type Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + type family Lambda_0123456789876543210 _f_0123456789876543210 a_0123456789876543210 t where + Lambda_0123456789876543210 _f_0123456789876543210 a_0123456789876543210 n_0123456789876543210 = MemptySym0 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) @@ -482,21 +493,6 @@ Singletons/FunctorLikeDeriving.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 - type family Lambda_0123456789876543210 _f_0123456789876543210 a_0123456789876543210 t where - Lambda_0123456789876543210 _f_0123456789876543210 a_0123456789876543210 n_0123456789876543210 = MemptySym0 - type Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 = - Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) - data Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 - where - Lambda_0123456789876543210Sym2KindInference :: forall _f_01234567898765432100123456789876543210 - a_01234567898765432100123456789876543210 - t0123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) @@ -507,31 +503,22 @@ Singletons/FunctorLikeDeriving.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) - data Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 where - Lambda_0123456789876543210Sym0KindInference :: forall _f_01234567898765432100123456789876543210 - arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 + Lambda_0123456789876543210Sym2KindInference :: forall _f_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + type Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 type family FoldMap_0123456789876543210 (a :: (~>) a0123456789876543210 m0123456789876543210) (a :: T x a0123456789876543210) :: m0123456789876543210 where FoldMap_0123456789876543210 _f_0123456789876543210 (MkT1 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) = Apply (Apply MappendSym0 (Apply (Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210)) (Apply (Apply MappendSym0 (Apply _f_0123456789876543210 a_0123456789876543210)) (Apply (Apply MappendSym0 (Apply (Apply FoldMapSym0 _f_0123456789876543210) a_0123456789876543210)) (Apply (Apply FoldMapSym0 (Apply FoldMapSym0 _f_0123456789876543210)) a_0123456789876543210))) FoldMap_0123456789876543210 _f_0123456789876543210 (MkT2 a_0123456789876543210) = Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) a_0123456789876543210) a_0123456789876543210 - type FoldMap_0123456789876543210Sym2 (a0123456789876543210 :: (~>) a01234567898765432100123456789876543210 m01234567898765432100123456789876543210) (a0123456789876543210 :: T x0123456789876543210 a01234567898765432100123456789876543210) = - FoldMap_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (FoldMap_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd (((,) FoldMap_0123456789876543210Sym1KindInference) ()) - data FoldMap_0123456789876543210Sym1 (a0123456789876543210 :: (~>) a01234567898765432100123456789876543210 m01234567898765432100123456789876543210) :: forall x0123456789876543210. - (~>) (T x0123456789876543210 a01234567898765432100123456789876543210) m01234567898765432100123456789876543210 - where - FoldMap_0123456789876543210Sym1KindInference :: forall a0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply (FoldMap_0123456789876543210Sym1 a0123456789876543210) arg) (FoldMap_0123456789876543210Sym2 a0123456789876543210 arg) => - FoldMap_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 - type instance Apply (FoldMap_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = FoldMap_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings FoldMap_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) FoldMap_0123456789876543210Sym0KindInference) ()) @@ -544,42 +531,77 @@ Singletons/FunctorLikeDeriving.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply FoldMap_0123456789876543210Sym0 arg) (FoldMap_0123456789876543210Sym1 arg) => FoldMap_0123456789876543210Sym0 a0123456789876543210 type instance Apply FoldMap_0123456789876543210Sym0 a0123456789876543210 = FoldMap_0123456789876543210Sym1 a0123456789876543210 + instance SuppressUnusedWarnings (FoldMap_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) FoldMap_0123456789876543210Sym1KindInference) ()) + data FoldMap_0123456789876543210Sym1 (a0123456789876543210 :: (~>) a01234567898765432100123456789876543210 m01234567898765432100123456789876543210) :: forall x0123456789876543210. + (~>) (T x0123456789876543210 a01234567898765432100123456789876543210) m01234567898765432100123456789876543210 + where + FoldMap_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (FoldMap_0123456789876543210Sym1 a0123456789876543210) arg) (FoldMap_0123456789876543210Sym2 a0123456789876543210 arg) => + FoldMap_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (FoldMap_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = FoldMap_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 + type FoldMap_0123456789876543210Sym2 (a0123456789876543210 :: (~>) a01234567898765432100123456789876543210 m01234567898765432100123456789876543210) (a0123456789876543210 :: T x0123456789876543210 a01234567898765432100123456789876543210) = + FoldMap_0123456789876543210 a0123456789876543210 a0123456789876543210 type family Lambda_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 t t where Lambda_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n1_0123456789876543210 n2_0123456789876543210 = n2_0123456789876543210 - type Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 = - Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym7 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym7KindInference) ()) - data Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym7KindInference :: forall _f_01234567898765432100123456789876543210 - _z_01234567898765432100123456789876543210 - a_01234567898765432100123456789876543210 + Lambda_0123456789876543210Sym0KindInference :: forall _f_01234567898765432100123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) + data Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym1KindInference :: forall _f_01234567898765432100123456789876543210 + _z_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) _z_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym2KindInference :: forall _f_01234567898765432100123456789876543210 + _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) + data Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + where + Lambda_0123456789876543210Sym3KindInference :: forall _f_01234567898765432100123456789876543210 + _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - t0123456789876543210 - t0123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210) arg) (Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 arg) => - Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym7 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym8 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym6 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + arg. SameKind (Apply (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym6KindInference) ()) - data Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym4KindInference) ()) + data Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym6KindInference :: forall _f_01234567898765432100123456789876543210 + Lambda_0123456789876543210Sym4KindInference :: forall _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - a_01234567898765432100123456789876543210 - t0123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym6 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym7 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + arg. SameKind (Apply (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym5KindInference) ()) data Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 @@ -592,43 +614,51 @@ Singletons/FunctorLikeDeriving.hs:(0,0)-(0,0): Splicing declarations a_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym6 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + type instance Apply (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym4KindInference) ()) - data Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym6KindInference) ()) + data Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 where - Lambda_0123456789876543210Sym4KindInference :: forall _f_01234567898765432100123456789876543210 + Lambda_0123456789876543210Sym6KindInference :: forall _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + a_01234567898765432100123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) - data Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym7KindInference) ()) + data Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 where - Lambda_0123456789876543210Sym3KindInference :: forall _f_01234567898765432100123456789876543210 + Lambda_0123456789876543210Sym7KindInference :: forall _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210) arg) (Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 arg) => + Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 + type Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 + type family Lambda_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 t t where + Lambda_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n1_0123456789876543210 n2_0123456789876543210 = Apply (Apply (Apply FoldrSym0 _f_0123456789876543210) n2_0123456789876543210) n1_0123456789876543210 + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) - data Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym2KindInference :: forall _f_01234567898765432100123456789876543210 - _z_01234567898765432100123456789876543210 - a_01234567898765432100123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + Lambda_0123456789876543210Sym0KindInference :: forall _f_01234567898765432100123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) @@ -639,51 +669,43 @@ Singletons/FunctorLikeDeriving.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) _z_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) - data Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym0KindInference :: forall _f_01234567898765432100123456789876543210 - arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 - type family Lambda_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 t t where - Lambda_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n1_0123456789876543210 n2_0123456789876543210 = Apply (Apply (Apply FoldrSym0 _f_0123456789876543210) n2_0123456789876543210) n1_0123456789876543210 - type Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 = - Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym7 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + Lambda_0123456789876543210Sym2KindInference :: forall _f_01234567898765432100123456789876543210 + _z_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym7KindInference) ()) - data Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) + data Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym7KindInference :: forall _f_01234567898765432100123456789876543210 + Lambda_0123456789876543210Sym3KindInference :: forall _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - a_01234567898765432100123456789876543210 - a_01234567898765432100123456789876543210 - t0123456789876543210 - t0123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210) arg) (Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 arg) => - Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym7 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym8 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym6 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + arg. SameKind (Apply (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym6KindInference) ()) - data Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym4KindInference) ()) + data Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym6KindInference :: forall _f_01234567898765432100123456789876543210 + Lambda_0123456789876543210Sym4KindInference :: forall _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - a_01234567898765432100123456789876543210 - t0123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym6 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym7 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + arg. SameKind (Apply (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym5KindInference) ()) data Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 @@ -696,118 +718,112 @@ Singletons/FunctorLikeDeriving.hs:(0,0)-(0,0): Splicing declarations a_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym6 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + type instance Apply (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym4KindInference) ()) - data Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym6KindInference) ()) + data Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 where - Lambda_0123456789876543210Sym4KindInference :: forall _f_01234567898765432100123456789876543210 + Lambda_0123456789876543210Sym6KindInference :: forall _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + a_01234567898765432100123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) - data Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym7KindInference) ()) + data Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 where - Lambda_0123456789876543210Sym3KindInference :: forall _f_01234567898765432100123456789876543210 + Lambda_0123456789876543210Sym7KindInference :: forall _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210) arg) (Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 arg) => + Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 + type Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 + type family Lambda_0123456789876543210 n1_0123456789876543210 n2_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 t t where + Lambda_0123456789876543210 n1_0123456789876543210 n2_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n1_0123456789876543210 n2_0123456789876543210 = Apply (Apply (Apply FoldrSym0 _f_0123456789876543210) n2_0123456789876543210) n1_0123456789876543210 + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) - data Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 n1_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym2KindInference :: forall _f_01234567898765432100123456789876543210 - _z_01234567898765432100123456789876543210 - a_01234567898765432100123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) where + Lambda_0123456789876543210Sym0KindInference :: forall n1_01234567898765432100123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 n1_01234567898765432100123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 n1_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 n1_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 n1_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) - data Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 + data Lambda_0123456789876543210Sym1 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym1KindInference :: forall _f_01234567898765432100123456789876543210 - _z_01234567898765432100123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) _z_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + Lambda_0123456789876543210Sym1KindInference :: forall n1_01234567898765432100123456789876543210 + n2_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym1 n1_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 n1_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym1 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym1 n1_01234567898765432100123456789876543210) n2_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) - data Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym0KindInference :: forall _f_01234567898765432100123456789876543210 - arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 - type family Lambda_0123456789876543210 n1_0123456789876543210 n2_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 t t where - Lambda_0123456789876543210 n1_0123456789876543210 n2_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n1_0123456789876543210 n2_0123456789876543210 = Apply (Apply (Apply FoldrSym0 _f_0123456789876543210) n2_0123456789876543210) n1_0123456789876543210 - type Lambda_0123456789876543210Sym10 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 = - Lambda_0123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym9 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210) where + Lambda_0123456789876543210Sym2KindInference :: forall n1_01234567898765432100123456789876543210 + n2_01234567898765432100123456789876543210 + _f_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym2 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym2 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210) _f_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym3 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym9KindInference) ()) - data Lambda_0123456789876543210Sym9 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) + data Lambda_0123456789876543210Sym3 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym9KindInference :: forall n1_01234567898765432100123456789876543210 + Lambda_0123456789876543210Sym3KindInference :: forall n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 - a_01234567898765432100123456789876543210 - a_01234567898765432100123456789876543210 - a_01234567898765432100123456789876543210 - a_01234567898765432100123456789876543210 - t0123456789876543210 - t0123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym9 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210) arg) (Lambda_0123456789876543210Sym10 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 arg) => - Lambda_0123456789876543210Sym9 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym9 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym10 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym8 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210) where + arg. SameKind (Apply (Lambda_0123456789876543210Sym3 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym4 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym3 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym3 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) _z_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym4 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym8KindInference) ()) - data Lambda_0123456789876543210Sym8 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym4KindInference) ()) + data Lambda_0123456789876543210Sym4 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym8KindInference :: forall n1_01234567898765432100123456789876543210 + Lambda_0123456789876543210Sym4KindInference :: forall n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - a_01234567898765432100123456789876543210 - a_01234567898765432100123456789876543210 - a_01234567898765432100123456789876543210 - t0123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym8 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym9 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym8 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym8 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym9 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym7 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210) where + arg. SameKind (Apply (Lambda_0123456789876543210Sym4 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym5 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym4 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym4 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym5 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym5 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym7KindInference) ()) - data Lambda_0123456789876543210Sym7 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym5KindInference) ()) + data Lambda_0123456789876543210Sym5 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym7KindInference :: forall n1_01234567898765432100123456789876543210 + Lambda_0123456789876543210Sym5KindInference :: forall n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - a_01234567898765432100123456789876543210 - a_01234567898765432100123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym7 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym8 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym7 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym7 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym8 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym6 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210) where + arg. SameKind (Apply (Lambda_0123456789876543210Sym5 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym6 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym5 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym5 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym6 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym6 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym6KindInference) ()) data Lambda_0123456789876543210Sym6 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 @@ -821,112 +837,118 @@ Singletons/FunctorLikeDeriving.hs:(0,0)-(0,0): Splicing declarations a_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym6 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym7 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym6 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym6 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym7 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210) where + type instance Apply (Lambda_0123456789876543210Sym6 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym7 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym7 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym5KindInference) ()) - data Lambda_0123456789876543210Sym5 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym7KindInference) ()) + data Lambda_0123456789876543210Sym7 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym5KindInference :: forall n1_01234567898765432100123456789876543210 + Lambda_0123456789876543210Sym7KindInference :: forall n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym5 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym6 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym5 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym6 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210) where + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym7 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym8 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym7 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym7 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym8 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym8 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym4KindInference) ()) - data Lambda_0123456789876543210Sym4 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym8KindInference) ()) + data Lambda_0123456789876543210Sym8 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 where - Lambda_0123456789876543210Sym4KindInference :: forall n1_01234567898765432100123456789876543210 + Lambda_0123456789876543210Sym8KindInference :: forall n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym4 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym5 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym4 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym4 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym5 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210) where + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym8 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym9 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym8 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym8 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym9 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym9 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) - data Lambda_0123456789876543210Sym3 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym9KindInference) ()) + data Lambda_0123456789876543210Sym9 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 where - Lambda_0123456789876543210Sym3KindInference :: forall n1_01234567898765432100123456789876543210 + Lambda_0123456789876543210Sym9KindInference :: forall n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym3 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym4 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym3 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210) _z_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210) where + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym9 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210) arg) (Lambda_0123456789876543210Sym10 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 arg) => + Lambda_0123456789876543210Sym9 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym9 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym10 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 + type Lambda_0123456789876543210Sym10 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 + type family Lambda_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 t t where + Lambda_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n1_0123456789876543210 n2_0123456789876543210 = Apply (Apply (Apply FoldrSym0 (Apply (Apply (Apply (Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 n1_0123456789876543210) n2_0123456789876543210) _f_0123456789876543210) _z_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210)) n2_0123456789876543210) n1_0123456789876543210 + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) - data Lambda_0123456789876543210Sym2 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym2KindInference :: forall n1_01234567898765432100123456789876543210 - n2_01234567898765432100123456789876543210 - _f_01234567898765432100123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym2 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym2 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210) _f_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym3 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 n1_01234567898765432100123456789876543210) where + Lambda_0123456789876543210Sym0KindInference :: forall _f_01234567898765432100123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) - data Lambda_0123456789876543210Sym1 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 + data Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym1KindInference :: forall n1_01234567898765432100123456789876543210 - n2_01234567898765432100123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym1 n1_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 n1_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym1 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym1 n1_01234567898765432100123456789876543210) n2_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + Lambda_0123456789876543210Sym1KindInference :: forall _f_01234567898765432100123456789876543210 + _z_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) _z_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) - data Lambda_0123456789876543210Sym0 n1_01234567898765432100123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym0KindInference :: forall n1_01234567898765432100123456789876543210 - arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 n1_01234567898765432100123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 n1_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 n1_01234567898765432100123456789876543210 - type family Lambda_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 t t where - Lambda_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n1_0123456789876543210 n2_0123456789876543210 = Apply (Apply (Apply FoldrSym0 (Apply (Apply (Apply (Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 n1_0123456789876543210) n2_0123456789876543210) _f_0123456789876543210) _z_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210)) n2_0123456789876543210) n1_0123456789876543210 - type Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 = - Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym7 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + Lambda_0123456789876543210Sym2KindInference :: forall _f_01234567898765432100123456789876543210 + _z_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym7KindInference) ()) - data Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) + data Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym7KindInference :: forall _f_01234567898765432100123456789876543210 + Lambda_0123456789876543210Sym3KindInference :: forall _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - a_01234567898765432100123456789876543210 - a_01234567898765432100123456789876543210 - t0123456789876543210 - t0123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210) arg) (Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 arg) => - Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym7 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym8 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym6 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + arg. SameKind (Apply (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym6KindInference) ()) - data Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym4KindInference) ()) + data Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym6KindInference :: forall _f_01234567898765432100123456789876543210 + Lambda_0123456789876543210Sym4KindInference :: forall _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - a_01234567898765432100123456789876543210 - t0123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym6 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym7 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + arg. SameKind (Apply (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym5KindInference) ()) data Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 @@ -939,43 +961,51 @@ Singletons/FunctorLikeDeriving.hs:(0,0)-(0,0): Splicing declarations a_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym6 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + type instance Apply (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym4KindInference) ()) - data Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym6KindInference) ()) + data Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 where - Lambda_0123456789876543210Sym4KindInference :: forall _f_01234567898765432100123456789876543210 + Lambda_0123456789876543210Sym6KindInference :: forall _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + a_01234567898765432100123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) - data Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym7KindInference) ()) + data Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 where - Lambda_0123456789876543210Sym3KindInference :: forall _f_01234567898765432100123456789876543210 + Lambda_0123456789876543210Sym7KindInference :: forall _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + a_01234567898765432100123456789876543210 + a_01234567898765432100123456789876543210 + t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210) arg) (Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 arg) => + Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 + type Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 + type family Lambda_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 t t where + Lambda_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 n1_0123456789876543210 n2_0123456789876543210 = n2_0123456789876543210 + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) - data Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym2KindInference :: forall _f_01234567898765432100123456789876543210 - _z_01234567898765432100123456789876543210 - a_01234567898765432100123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + Lambda_0123456789876543210Sym0KindInference :: forall _f_01234567898765432100123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) @@ -986,33 +1016,18 @@ Singletons/FunctorLikeDeriving.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) _z_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) - data Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym0KindInference :: forall _f_01234567898765432100123456789876543210 - arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 - type family Lambda_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 t t where - Lambda_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 n1_0123456789876543210 n2_0123456789876543210 = n2_0123456789876543210 - type Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 = - Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 t0123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym4KindInference) ()) - data Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym4KindInference :: forall _f_01234567898765432100123456789876543210 + Lambda_0123456789876543210Sym2KindInference :: forall _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - t0123456789876543210 - t0123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210) arg) (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 arg) => - Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym4 t0123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym5 t0123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 arg) => + Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) data Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 @@ -1023,54 +1038,37 @@ Singletons/FunctorLikeDeriving.hs:(0,0)-(0,0): Splicing declarations t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + type instance Apply (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) - data Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym4KindInference) ()) + data Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 where - Lambda_0123456789876543210Sym2KindInference :: forall _f_01234567898765432100123456789876543210 + Lambda_0123456789876543210Sym4KindInference :: forall _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) where - suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) - data Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym1KindInference :: forall _f_01234567898765432100123456789876543210 - _z_01234567898765432100123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) _z_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) - data Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 - where - Lambda_0123456789876543210Sym0KindInference :: forall _f_01234567898765432100123456789876543210 - arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 + t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210) arg) (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 arg) => + Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 + type Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 type family Foldr_0123456789876543210 (a :: (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210)) (a :: b0123456789876543210) (a :: T x a0123456789876543210) :: b0123456789876543210 where Foldr_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 (MkT1 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) = Apply (Apply (Apply (Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) _z_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) (Apply (Apply _f_0123456789876543210 a_0123456789876543210) (Apply (Apply (Apply (Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) _z_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) (Apply (Apply (Apply (Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) _z_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) _z_0123456789876543210))) Foldr_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 (MkT2 a_0123456789876543210) = Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) _z_0123456789876543210) a_0123456789876543210) a_0123456789876543210) _z_0123456789876543210 - type Foldr_0123456789876543210Sym3 (a0123456789876543210 :: (~>) a01234567898765432100123456789876543210 ((~>) b01234567898765432100123456789876543210 b01234567898765432100123456789876543210)) (a0123456789876543210 :: b01234567898765432100123456789876543210) (a0123456789876543210 :: T x0123456789876543210 a01234567898765432100123456789876543210) = - Foldr_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (Foldr_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where + instance SuppressUnusedWarnings Foldr_0123456789876543210Sym0 where suppressUnusedWarnings - = snd (((,) Foldr_0123456789876543210Sym2KindInference) ()) - data Foldr_0123456789876543210Sym2 (a0123456789876543210 :: (~>) a01234567898765432100123456789876543210 ((~>) b01234567898765432100123456789876543210 b01234567898765432100123456789876543210)) (a0123456789876543210 :: b01234567898765432100123456789876543210) :: forall x0123456789876543210. - (~>) (T x0123456789876543210 a01234567898765432100123456789876543210) b01234567898765432100123456789876543210 + = snd (((,) Foldr_0123456789876543210Sym0KindInference) ()) + data Foldr_0123456789876543210Sym0 :: forall a01234567898765432100123456789876543210 + b01234567898765432100123456789876543210 + x0123456789876543210. + (~>) ((~>) a01234567898765432100123456789876543210 ((~>) b01234567898765432100123456789876543210 b01234567898765432100123456789876543210)) ((~>) b01234567898765432100123456789876543210 ((~>) (T x0123456789876543210 a01234567898765432100123456789876543210) b01234567898765432100123456789876543210)) where - Foldr_0123456789876543210Sym2KindInference :: forall a0123456789876543210 - a0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply (Foldr_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (Foldr_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => - Foldr_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 - type instance Apply (Foldr_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = Foldr_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 + Foldr_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Foldr_0123456789876543210Sym0 arg) (Foldr_0123456789876543210Sym1 arg) => + Foldr_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Foldr_0123456789876543210Sym0 a0123456789876543210 = Foldr_0123456789876543210Sym1 a0123456789876543210 instance SuppressUnusedWarnings (Foldr_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Foldr_0123456789876543210Sym1KindInference) ()) @@ -1082,37 +1080,26 @@ Singletons/FunctorLikeDeriving.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Foldr_0123456789876543210Sym1 a0123456789876543210) arg) (Foldr_0123456789876543210Sym2 a0123456789876543210 arg) => Foldr_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Foldr_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Foldr_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings Foldr_0123456789876543210Sym0 where + instance SuppressUnusedWarnings (Foldr_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where suppressUnusedWarnings - = snd (((,) Foldr_0123456789876543210Sym0KindInference) ()) - data Foldr_0123456789876543210Sym0 :: forall a01234567898765432100123456789876543210 - b01234567898765432100123456789876543210 - x0123456789876543210. - (~>) ((~>) a01234567898765432100123456789876543210 ((~>) b01234567898765432100123456789876543210 b01234567898765432100123456789876543210)) ((~>) b01234567898765432100123456789876543210 ((~>) (T x0123456789876543210 a01234567898765432100123456789876543210) b01234567898765432100123456789876543210)) + = snd (((,) Foldr_0123456789876543210Sym2KindInference) ()) + data Foldr_0123456789876543210Sym2 (a0123456789876543210 :: (~>) a01234567898765432100123456789876543210 ((~>) b01234567898765432100123456789876543210 b01234567898765432100123456789876543210)) (a0123456789876543210 :: b01234567898765432100123456789876543210) :: forall x0123456789876543210. + (~>) (T x0123456789876543210 a01234567898765432100123456789876543210) b01234567898765432100123456789876543210 where - Foldr_0123456789876543210Sym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply Foldr_0123456789876543210Sym0 arg) (Foldr_0123456789876543210Sym1 arg) => - Foldr_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Foldr_0123456789876543210Sym0 a0123456789876543210 = Foldr_0123456789876543210Sym1 a0123456789876543210 + Foldr_0123456789876543210Sym2KindInference :: forall a0123456789876543210 + a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Foldr_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (Foldr_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => + Foldr_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type instance Apply (Foldr_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = Foldr_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type Foldr_0123456789876543210Sym3 (a0123456789876543210 :: (~>) a01234567898765432100123456789876543210 ((~>) b01234567898765432100123456789876543210 b01234567898765432100123456789876543210)) (a0123456789876543210 :: b01234567898765432100123456789876543210) (a0123456789876543210 :: T x0123456789876543210 a01234567898765432100123456789876543210) = + Foldr_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance PFoldable (T x) where type FoldMap a a = Apply (Apply FoldMap_0123456789876543210Sym0 a) a type Foldr a a a = Apply (Apply (Apply Foldr_0123456789876543210Sym0 a) a) a type family Traverse_0123456789876543210 (a :: (~>) a0123456789876543210 (f0123456789876543210 b0123456789876543210)) (a :: T x a0123456789876543210) :: f0123456789876543210 (T x b0123456789876543210) where Traverse_0123456789876543210 _f_0123456789876543210 (MkT1 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) = Apply (Apply (<*>@#@$) (Apply (Apply (<*>@#@$) (Apply (Apply (Apply LiftA2Sym0 MkT1Sym0) (Apply PureSym0 a_0123456789876543210)) (Apply _f_0123456789876543210 a_0123456789876543210))) (Apply (Apply TraverseSym0 _f_0123456789876543210) a_0123456789876543210))) (Apply (Apply TraverseSym0 (Apply TraverseSym0 _f_0123456789876543210)) a_0123456789876543210) Traverse_0123456789876543210 _f_0123456789876543210 (MkT2 a_0123456789876543210) = Apply (Apply FmapSym0 MkT2Sym0) (Apply PureSym0 a_0123456789876543210) - type Traverse_0123456789876543210Sym2 (a0123456789876543210 :: (~>) a01234567898765432100123456789876543210 (f01234567898765432100123456789876543210 b01234567898765432100123456789876543210)) (a0123456789876543210 :: T x0123456789876543210 a01234567898765432100123456789876543210) = - Traverse_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (Traverse_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd (((,) Traverse_0123456789876543210Sym1KindInference) ()) - data Traverse_0123456789876543210Sym1 (a0123456789876543210 :: (~>) a01234567898765432100123456789876543210 (f01234567898765432100123456789876543210 b01234567898765432100123456789876543210)) :: forall x0123456789876543210. - (~>) (T x0123456789876543210 a01234567898765432100123456789876543210) (f01234567898765432100123456789876543210 (T x0123456789876543210 b01234567898765432100123456789876543210)) - where - Traverse_0123456789876543210Sym1KindInference :: forall a0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply (Traverse_0123456789876543210Sym1 a0123456789876543210) arg) (Traverse_0123456789876543210Sym2 a0123456789876543210 arg) => - Traverse_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 - type instance Apply (Traverse_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Traverse_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Traverse_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Traverse_0123456789876543210Sym0KindInference) ()) @@ -1126,23 +1113,24 @@ Singletons/FunctorLikeDeriving.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Traverse_0123456789876543210Sym0 arg) (Traverse_0123456789876543210Sym1 arg) => Traverse_0123456789876543210Sym0 a0123456789876543210 type instance Apply Traverse_0123456789876543210Sym0 a0123456789876543210 = Traverse_0123456789876543210Sym1 a0123456789876543210 + instance SuppressUnusedWarnings (Traverse_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Traverse_0123456789876543210Sym1KindInference) ()) + data Traverse_0123456789876543210Sym1 (a0123456789876543210 :: (~>) a01234567898765432100123456789876543210 (f01234567898765432100123456789876543210 b01234567898765432100123456789876543210)) :: forall x0123456789876543210. + (~>) (T x0123456789876543210 a01234567898765432100123456789876543210) (f01234567898765432100123456789876543210 (T x0123456789876543210 b01234567898765432100123456789876543210)) + where + Traverse_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Traverse_0123456789876543210Sym1 a0123456789876543210) arg) (Traverse_0123456789876543210Sym2 a0123456789876543210 arg) => + Traverse_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Traverse_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Traverse_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 + type Traverse_0123456789876543210Sym2 (a0123456789876543210 :: (~>) a01234567898765432100123456789876543210 (f01234567898765432100123456789876543210 b01234567898765432100123456789876543210)) (a0123456789876543210 :: T x0123456789876543210 a01234567898765432100123456789876543210) = + Traverse_0123456789876543210 a0123456789876543210 a0123456789876543210 instance PTraversable (T x) where type Traverse a a = Apply (Apply Traverse_0123456789876543210Sym0 a) a type family Case_0123456789876543210 v_0123456789876543210 t where type family Fmap_0123456789876543210 (a :: (~>) a0123456789876543210 b0123456789876543210) (a :: Empty a0123456789876543210) :: Empty b0123456789876543210 where Fmap_0123456789876543210 _ v_0123456789876543210 = Case_0123456789876543210 v_0123456789876543210 v_0123456789876543210 - type Fmap_0123456789876543210Sym2 (a0123456789876543210 :: (~>) a01234567898765432100123456789876543210 b01234567898765432100123456789876543210) (a0123456789876543210 :: Empty a01234567898765432100123456789876543210) = - Fmap_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (Fmap_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd (((,) Fmap_0123456789876543210Sym1KindInference) ()) - data Fmap_0123456789876543210Sym1 (a0123456789876543210 :: (~>) a01234567898765432100123456789876543210 b01234567898765432100123456789876543210) :: (~>) (Empty a01234567898765432100123456789876543210) (Empty b01234567898765432100123456789876543210) - where - Fmap_0123456789876543210Sym1KindInference :: forall a0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply (Fmap_0123456789876543210Sym1 a0123456789876543210) arg) (Fmap_0123456789876543210Sym2 a0123456789876543210 arg) => - Fmap_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 - type instance Apply (Fmap_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Fmap_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Fmap_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Fmap_0123456789876543210Sym0KindInference) ()) @@ -1154,22 +1142,21 @@ Singletons/FunctorLikeDeriving.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Fmap_0123456789876543210Sym0 arg) (Fmap_0123456789876543210Sym1 arg) => Fmap_0123456789876543210Sym0 a0123456789876543210 type instance Apply Fmap_0123456789876543210Sym0 a0123456789876543210 = Fmap_0123456789876543210Sym1 a0123456789876543210 + instance SuppressUnusedWarnings (Fmap_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Fmap_0123456789876543210Sym1KindInference) ()) + data Fmap_0123456789876543210Sym1 (a0123456789876543210 :: (~>) a01234567898765432100123456789876543210 b01234567898765432100123456789876543210) :: (~>) (Empty a01234567898765432100123456789876543210) (Empty b01234567898765432100123456789876543210) + where + Fmap_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Fmap_0123456789876543210Sym1 a0123456789876543210) arg) (Fmap_0123456789876543210Sym2 a0123456789876543210 arg) => + Fmap_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Fmap_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Fmap_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 + type Fmap_0123456789876543210Sym2 (a0123456789876543210 :: (~>) a01234567898765432100123456789876543210 b01234567898765432100123456789876543210) (a0123456789876543210 :: Empty a01234567898765432100123456789876543210) = + Fmap_0123456789876543210 a0123456789876543210 a0123456789876543210 type family Case_0123456789876543210 v_0123456789876543210 t where type family TFHelper_0123456789876543210 (a :: a) (a :: Empty b) :: Empty a where TFHelper_0123456789876543210 _ v_0123456789876543210 = Case_0123456789876543210 v_0123456789876543210 v_0123456789876543210 - type TFHelper_0123456789876543210Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: Empty b0123456789876543210) = - TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (TFHelper_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd (((,) TFHelper_0123456789876543210Sym1KindInference) ()) - data TFHelper_0123456789876543210Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. - (~>) (Empty b0123456789876543210) (Empty a0123456789876543210) - where - TFHelper_0123456789876543210Sym1KindInference :: forall a0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply (TFHelper_0123456789876543210Sym1 a0123456789876543210) arg) (TFHelper_0123456789876543210Sym2 a0123456789876543210 arg) => - TFHelper_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 - type instance Apply (TFHelper_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = TFHelper_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) TFHelper_0123456789876543210Sym0KindInference) ()) @@ -1181,23 +1168,24 @@ Singletons/FunctorLikeDeriving.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply TFHelper_0123456789876543210Sym0 arg) (TFHelper_0123456789876543210Sym1 arg) => TFHelper_0123456789876543210Sym0 a0123456789876543210 type instance Apply TFHelper_0123456789876543210Sym0 a0123456789876543210 = TFHelper_0123456789876543210Sym1 a0123456789876543210 + instance SuppressUnusedWarnings (TFHelper_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) TFHelper_0123456789876543210Sym1KindInference) ()) + data TFHelper_0123456789876543210Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. + (~>) (Empty b0123456789876543210) (Empty a0123456789876543210) + where + TFHelper_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (TFHelper_0123456789876543210Sym1 a0123456789876543210) arg) (TFHelper_0123456789876543210Sym2 a0123456789876543210 arg) => + TFHelper_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (TFHelper_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = TFHelper_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 + type TFHelper_0123456789876543210Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: Empty b0123456789876543210) = + TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210 instance PFunctor Empty where type Fmap a a = Apply (Apply Fmap_0123456789876543210Sym0 a) a type (<$) a a = Apply (Apply TFHelper_0123456789876543210Sym0 a) a type family FoldMap_0123456789876543210 (a :: (~>) a0123456789876543210 m0123456789876543210) (a :: Empty a0123456789876543210) :: m0123456789876543210 where FoldMap_0123456789876543210 _ _ = MemptySym0 - type FoldMap_0123456789876543210Sym2 (a0123456789876543210 :: (~>) a01234567898765432100123456789876543210 m01234567898765432100123456789876543210) (a0123456789876543210 :: Empty a01234567898765432100123456789876543210) = - FoldMap_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (FoldMap_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd (((,) FoldMap_0123456789876543210Sym1KindInference) ()) - data FoldMap_0123456789876543210Sym1 (a0123456789876543210 :: (~>) a01234567898765432100123456789876543210 m01234567898765432100123456789876543210) :: (~>) (Empty a01234567898765432100123456789876543210) m01234567898765432100123456789876543210 - where - FoldMap_0123456789876543210Sym1KindInference :: forall a0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply (FoldMap_0123456789876543210Sym1 a0123456789876543210) arg) (FoldMap_0123456789876543210Sym2 a0123456789876543210 arg) => - FoldMap_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 - type instance Apply (FoldMap_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = FoldMap_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings FoldMap_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) FoldMap_0123456789876543210Sym0KindInference) ()) @@ -1209,23 +1197,23 @@ Singletons/FunctorLikeDeriving.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply FoldMap_0123456789876543210Sym0 arg) (FoldMap_0123456789876543210Sym1 arg) => FoldMap_0123456789876543210Sym0 a0123456789876543210 type instance Apply FoldMap_0123456789876543210Sym0 a0123456789876543210 = FoldMap_0123456789876543210Sym1 a0123456789876543210 + instance SuppressUnusedWarnings (FoldMap_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) FoldMap_0123456789876543210Sym1KindInference) ()) + data FoldMap_0123456789876543210Sym1 (a0123456789876543210 :: (~>) a01234567898765432100123456789876543210 m01234567898765432100123456789876543210) :: (~>) (Empty a01234567898765432100123456789876543210) m01234567898765432100123456789876543210 + where + FoldMap_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (FoldMap_0123456789876543210Sym1 a0123456789876543210) arg) (FoldMap_0123456789876543210Sym2 a0123456789876543210 arg) => + FoldMap_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (FoldMap_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = FoldMap_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 + type FoldMap_0123456789876543210Sym2 (a0123456789876543210 :: (~>) a01234567898765432100123456789876543210 m01234567898765432100123456789876543210) (a0123456789876543210 :: Empty a01234567898765432100123456789876543210) = + FoldMap_0123456789876543210 a0123456789876543210 a0123456789876543210 instance PFoldable Empty where type FoldMap a a = Apply (Apply FoldMap_0123456789876543210Sym0 a) a type family Case_0123456789876543210 v_0123456789876543210 t where type family Traverse_0123456789876543210 (a :: (~>) a0123456789876543210 (f0123456789876543210 b0123456789876543210)) (a :: Empty a0123456789876543210) :: f0123456789876543210 (Empty b0123456789876543210) where Traverse_0123456789876543210 _ v_0123456789876543210 = Apply PureSym0 (Case_0123456789876543210 v_0123456789876543210 v_0123456789876543210) - type Traverse_0123456789876543210Sym2 (a0123456789876543210 :: (~>) a01234567898765432100123456789876543210 (f01234567898765432100123456789876543210 b01234567898765432100123456789876543210)) (a0123456789876543210 :: Empty a01234567898765432100123456789876543210) = - Traverse_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (Traverse_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd (((,) Traverse_0123456789876543210Sym1KindInference) ()) - data Traverse_0123456789876543210Sym1 (a0123456789876543210 :: (~>) a01234567898765432100123456789876543210 (f01234567898765432100123456789876543210 b01234567898765432100123456789876543210)) :: (~>) (Empty a01234567898765432100123456789876543210) (f01234567898765432100123456789876543210 (Empty b01234567898765432100123456789876543210)) - where - Traverse_0123456789876543210Sym1KindInference :: forall a0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply (Traverse_0123456789876543210Sym1 a0123456789876543210) arg) (Traverse_0123456789876543210Sym2 a0123456789876543210 arg) => - Traverse_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 - type instance Apply (Traverse_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Traverse_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Traverse_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Traverse_0123456789876543210Sym0KindInference) ()) @@ -1238,6 +1226,18 @@ Singletons/FunctorLikeDeriving.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Traverse_0123456789876543210Sym0 arg) (Traverse_0123456789876543210Sym1 arg) => Traverse_0123456789876543210Sym0 a0123456789876543210 type instance Apply Traverse_0123456789876543210Sym0 a0123456789876543210 = Traverse_0123456789876543210Sym1 a0123456789876543210 + instance SuppressUnusedWarnings (Traverse_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Traverse_0123456789876543210Sym1KindInference) ()) + data Traverse_0123456789876543210Sym1 (a0123456789876543210 :: (~>) a01234567898765432100123456789876543210 (f01234567898765432100123456789876543210 b01234567898765432100123456789876543210)) :: (~>) (Empty a01234567898765432100123456789876543210) (f01234567898765432100123456789876543210 (Empty b01234567898765432100123456789876543210)) + where + Traverse_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Traverse_0123456789876543210Sym1 a0123456789876543210) arg) (Traverse_0123456789876543210Sym2 a0123456789876543210 arg) => + Traverse_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Traverse_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Traverse_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 + type Traverse_0123456789876543210Sym2 (a0123456789876543210 :: (~>) a01234567898765432100123456789876543210 (f01234567898765432100123456789876543210 b01234567898765432100123456789876543210)) (a0123456789876543210 :: Empty a01234567898765432100123456789876543210) = + Traverse_0123456789876543210 a0123456789876543210 a0123456789876543210 instance PTraversable Empty where type Traverse a a = Apply (Apply Traverse_0123456789876543210Sym0 a) a data ST :: forall x a. T x a -> Type diff --git a/tests/compile-and-dump/Singletons/HigherOrder.golden b/tests/compile-and-dump/Singletons/HigherOrder.golden index 9d1de65f..be6e070c 100644 --- a/tests/compile-and-dump/Singletons/HigherOrder.golden +++ b/tests/compile-and-dump/Singletons/HigherOrder.golden @@ -40,8 +40,6 @@ Singletons/HigherOrder.hs:(0,0)-(0,0): Splicing declarations = ((zipWith (\ n b -> if b then Succ (Succ n) else n)) ns) bs etad :: [Nat] -> [Bool] -> [Nat] etad = zipWith (\ n b -> if b then Succ (Succ n) else n) - type LeftSym1 (t0123456789876543210 :: a0123456789876543210) = - Left t0123456789876543210 instance SuppressUnusedWarnings LeftSym0 where suppressUnusedWarnings = snd (((,) LeftSym0KindInference) ()) data LeftSym0 :: forall a0123456789876543210 b0123456789876543210. @@ -51,8 +49,8 @@ Singletons/HigherOrder.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply LeftSym0 arg) (LeftSym1 arg) => LeftSym0 t0123456789876543210 type instance Apply LeftSym0 t0123456789876543210 = LeftSym1 t0123456789876543210 - type RightSym1 (t0123456789876543210 :: b0123456789876543210) = - Right t0123456789876543210 + type LeftSym1 (t0123456789876543210 :: a0123456789876543210) = + Left t0123456789876543210 instance SuppressUnusedWarnings RightSym0 where suppressUnusedWarnings = snd (((,) RightSym0KindInference) ()) data RightSym0 :: forall b0123456789876543210 a0123456789876543210. @@ -62,25 +60,32 @@ Singletons/HigherOrder.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply RightSym0 arg) (RightSym1 arg) => RightSym0 t0123456789876543210 type instance Apply RightSym0 t0123456789876543210 = RightSym1 t0123456789876543210 + type RightSym1 (t0123456789876543210 :: b0123456789876543210) = + Right t0123456789876543210 type family Case_0123456789876543210 n b a_0123456789876543210 a_0123456789876543210 t where Case_0123456789876543210 n b a_0123456789876543210 a_0123456789876543210 'True = Apply SuccSym0 (Apply SuccSym0 n) Case_0123456789876543210 n b a_0123456789876543210 a_0123456789876543210 'False = n type family Lambda_0123456789876543210 a_0123456789876543210 a_0123456789876543210 t t where Lambda_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n b = Case_0123456789876543210 n b a_0123456789876543210 a_0123456789876543210 b - 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 + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) - data Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 a_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym3KindInference :: forall a_01234567898765432100123456789876543210 + 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 + 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 - 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_0123456789876543210Sym4 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + 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_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) @@ -92,45 +97,45 @@ Singletons/HigherOrder.hs:(0,0)-(0,0): Splicing declarations 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 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) - data Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) + data Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 where - Lambda_0123456789876543210Sym1KindInference :: forall a_01234567898765432100123456789876543210 + Lambda_0123456789876543210Sym3KindInference :: 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 + 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 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 + type Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 type family Case_0123456789876543210 n b ns bs t where Case_0123456789876543210 n b ns bs 'True = Apply SuccSym0 (Apply SuccSym0 n) Case_0123456789876543210 n b ns bs 'False = n type family Lambda_0123456789876543210 ns bs t t where Lambda_0123456789876543210 ns bs n b = Case_0123456789876543210 n b ns bs b - type Lambda_0123456789876543210Sym4 ns0123456789876543210 bs0123456789876543210 t0123456789876543210 t0123456789876543210 = - Lambda_0123456789876543210 ns0123456789876543210 bs0123456789876543210 t0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 t0123456789876543210 bs0123456789876543210 ns0123456789876543210) where + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) - data Lambda_0123456789876543210Sym3 ns0123456789876543210 bs0123456789876543210 t0123456789876543210 t0123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 ns0123456789876543210 where - Lambda_0123456789876543210Sym3KindInference :: forall ns0123456789876543210 + Lambda_0123456789876543210Sym0KindInference :: forall ns0123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 ns0123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 ns0123456789876543210 = Lambda_0123456789876543210Sym1 ns0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 ns0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) + data Lambda_0123456789876543210Sym1 ns0123456789876543210 bs0123456789876543210 + where + Lambda_0123456789876543210Sym1KindInference :: forall ns0123456789876543210 bs0123456789876543210 - t0123456789876543210 - t0123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym3 ns0123456789876543210 bs0123456789876543210 t0123456789876543210) arg) (Lambda_0123456789876543210Sym4 ns0123456789876543210 bs0123456789876543210 t0123456789876543210 arg) => - Lambda_0123456789876543210Sym3 ns0123456789876543210 bs0123456789876543210 t0123456789876543210 t0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym3 t0123456789876543210 bs0123456789876543210 ns0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym4 t0123456789876543210 bs0123456789876543210 ns0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 bs0123456789876543210 ns0123456789876543210) where + arg. SameKind (Apply (Lambda_0123456789876543210Sym1 ns0123456789876543210) arg) (Lambda_0123456789876543210Sym2 ns0123456789876543210 arg) => + Lambda_0123456789876543210Sym1 ns0123456789876543210 bs0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym1 ns0123456789876543210) bs0123456789876543210 = Lambda_0123456789876543210Sym2 ns0123456789876543210 bs0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 ns0123456789876543210 bs0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) data Lambda_0123456789876543210Sym2 ns0123456789876543210 bs0123456789876543210 t0123456789876543210 @@ -140,28 +145,29 @@ Singletons/HigherOrder.hs:(0,0)-(0,0): Splicing declarations t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym2 ns0123456789876543210 bs0123456789876543210) arg) (Lambda_0123456789876543210Sym3 ns0123456789876543210 bs0123456789876543210 arg) => Lambda_0123456789876543210Sym2 ns0123456789876543210 bs0123456789876543210 t0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 bs0123456789876543210 ns0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym3 bs0123456789876543210 ns0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 ns0123456789876543210) where + type instance Apply (Lambda_0123456789876543210Sym2 ns0123456789876543210 bs0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym3 ns0123456789876543210 bs0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 ns0123456789876543210 bs0123456789876543210 t0123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) - data Lambda_0123456789876543210Sym1 ns0123456789876543210 bs0123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) + data Lambda_0123456789876543210Sym3 ns0123456789876543210 bs0123456789876543210 t0123456789876543210 t0123456789876543210 where - Lambda_0123456789876543210Sym1KindInference :: forall ns0123456789876543210 + Lambda_0123456789876543210Sym3KindInference :: forall ns0123456789876543210 bs0123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym1 ns0123456789876543210) arg) (Lambda_0123456789876543210Sym2 ns0123456789876543210 arg) => - Lambda_0123456789876543210Sym1 ns0123456789876543210 bs0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym1 ns0123456789876543210) bs0123456789876543210 = Lambda_0123456789876543210Sym2 ns0123456789876543210 bs0123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) - data Lambda_0123456789876543210Sym0 ns0123456789876543210 + t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym3 ns0123456789876543210 bs0123456789876543210 t0123456789876543210) arg) (Lambda_0123456789876543210Sym4 ns0123456789876543210 bs0123456789876543210 t0123456789876543210 arg) => + Lambda_0123456789876543210Sym3 ns0123456789876543210 bs0123456789876543210 t0123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym3 ns0123456789876543210 bs0123456789876543210 t0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym4 ns0123456789876543210 bs0123456789876543210 t0123456789876543210 t0123456789876543210 + type Lambda_0123456789876543210Sym4 ns0123456789876543210 bs0123456789876543210 t0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 ns0123456789876543210 bs0123456789876543210 t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings EtadSym0 where + suppressUnusedWarnings = snd (((,) EtadSym0KindInference) ()) + data EtadSym0 :: (~>) [Nat] ((~>) [Bool] [Nat]) where - Lambda_0123456789876543210Sym0KindInference :: forall ns0123456789876543210 - arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 ns0123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 ns0123456789876543210 = Lambda_0123456789876543210Sym1 ns0123456789876543210 - type EtadSym2 (a0123456789876543210 :: [Nat]) (a0123456789876543210 :: [Bool]) = - Etad a0123456789876543210 a0123456789876543210 + EtadSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply EtadSym0 arg) (EtadSym1 arg) => + EtadSym0 a0123456789876543210 + type instance Apply EtadSym0 a0123456789876543210 = EtadSym1 a0123456789876543210 instance SuppressUnusedWarnings (EtadSym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) EtadSym1KindInference) ()) data EtadSym1 (a0123456789876543210 :: [Nat]) :: (~>) [Bool] [Nat] @@ -171,16 +177,16 @@ Singletons/HigherOrder.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (EtadSym1 a0123456789876543210) arg) (EtadSym2 a0123456789876543210 arg) => EtadSym1 a0123456789876543210 a0123456789876543210 type instance Apply (EtadSym1 a0123456789876543210) a0123456789876543210 = EtadSym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings EtadSym0 where - suppressUnusedWarnings = snd (((,) EtadSym0KindInference) ()) - data EtadSym0 :: (~>) [Nat] ((~>) [Bool] [Nat]) + type EtadSym2 (a0123456789876543210 :: [Nat]) (a0123456789876543210 :: [Bool]) = + Etad a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings SplungeSym0 where + suppressUnusedWarnings = snd (((,) SplungeSym0KindInference) ()) + data SplungeSym0 :: (~>) [Nat] ((~>) [Bool] [Nat]) where - EtadSym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply EtadSym0 arg) (EtadSym1 arg) => - EtadSym0 a0123456789876543210 - type instance Apply EtadSym0 a0123456789876543210 = EtadSym1 a0123456789876543210 - type SplungeSym2 (a0123456789876543210 :: [Nat]) (a0123456789876543210 :: [Bool]) = - Splunge a0123456789876543210 a0123456789876543210 + SplungeSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply SplungeSym0 arg) (SplungeSym1 arg) => + SplungeSym0 a0123456789876543210 + type instance Apply SplungeSym0 a0123456789876543210 = SplungeSym1 a0123456789876543210 instance SuppressUnusedWarnings (SplungeSym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) SplungeSym1KindInference) ()) data SplungeSym1 (a0123456789876543210 :: [Nat]) :: (~>) [Bool] [Nat] @@ -190,35 +196,8 @@ Singletons/HigherOrder.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (SplungeSym1 a0123456789876543210) arg) (SplungeSym2 a0123456789876543210 arg) => SplungeSym1 a0123456789876543210 a0123456789876543210 type instance Apply (SplungeSym1 a0123456789876543210) a0123456789876543210 = SplungeSym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings SplungeSym0 where - suppressUnusedWarnings = snd (((,) SplungeSym0KindInference) ()) - data SplungeSym0 :: (~>) [Nat] ((~>) [Bool] [Nat]) - where - SplungeSym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply SplungeSym0 arg) (SplungeSym1 arg) => - SplungeSym0 a0123456789876543210 - type instance Apply SplungeSym0 a0123456789876543210 = SplungeSym1 a0123456789876543210 - type FooSym3 (a0123456789876543210 :: (~>) ((~>) a0123456789876543210 b0123456789876543210) ((~>) a0123456789876543210 b0123456789876543210)) (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) (a0123456789876543210 :: a0123456789876543210) = - Foo a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (FooSym2 a0123456789876543210 a0123456789876543210) where - suppressUnusedWarnings = snd (((,) FooSym2KindInference) ()) - data FooSym2 (a0123456789876543210 :: (~>) ((~>) a0123456789876543210 b0123456789876543210) ((~>) a0123456789876543210 b0123456789876543210)) (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) :: (~>) a0123456789876543210 b0123456789876543210 - where - FooSym2KindInference :: forall a0123456789876543210 - a0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply (FooSym2 a0123456789876543210 a0123456789876543210) arg) (FooSym3 a0123456789876543210 a0123456789876543210 arg) => - FooSym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 - type instance Apply (FooSym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = FooSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (FooSym1 a0123456789876543210) where - suppressUnusedWarnings = snd (((,) FooSym1KindInference) ()) - data FooSym1 (a0123456789876543210 :: (~>) ((~>) a0123456789876543210 b0123456789876543210) ((~>) a0123456789876543210 b0123456789876543210)) :: (~>) ((~>) a0123456789876543210 b0123456789876543210) ((~>) a0123456789876543210 b0123456789876543210) - where - FooSym1KindInference :: forall a0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply (FooSym1 a0123456789876543210) arg) (FooSym2 a0123456789876543210 arg) => - FooSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (FooSym1 a0123456789876543210) a0123456789876543210 = FooSym2 a0123456789876543210 a0123456789876543210 + type SplungeSym2 (a0123456789876543210 :: [Nat]) (a0123456789876543210 :: [Bool]) = + Splunge a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings FooSym0 where suppressUnusedWarnings = snd (((,) FooSym0KindInference) ()) data FooSym0 :: forall a0123456789876543210 b0123456789876543210. @@ -228,27 +207,27 @@ Singletons/HigherOrder.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) => FooSym0 a0123456789876543210 type instance Apply FooSym0 a0123456789876543210 = FooSym1 a0123456789876543210 - type ZipWithSym3 (a0123456789876543210 :: (~>) a0123456789876543210 ((~>) b0123456789876543210 c0123456789876543210)) (a0123456789876543210 :: [a0123456789876543210]) (a0123456789876543210 :: [b0123456789876543210]) = - ZipWith a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (ZipWithSym2 a0123456789876543210 a0123456789876543210) where - suppressUnusedWarnings = snd (((,) ZipWithSym2KindInference) ()) - data ZipWithSym2 (a0123456789876543210 :: (~>) a0123456789876543210 ((~>) b0123456789876543210 c0123456789876543210)) (a0123456789876543210 :: [a0123456789876543210]) :: (~>) [b0123456789876543210] [c0123456789876543210] + instance SuppressUnusedWarnings (FooSym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) FooSym1KindInference) ()) + data FooSym1 (a0123456789876543210 :: (~>) ((~>) a0123456789876543210 b0123456789876543210) ((~>) a0123456789876543210 b0123456789876543210)) :: (~>) ((~>) a0123456789876543210 b0123456789876543210) ((~>) a0123456789876543210 b0123456789876543210) where - ZipWithSym2KindInference :: forall a0123456789876543210 - a0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply (ZipWithSym2 a0123456789876543210 a0123456789876543210) arg) (ZipWithSym3 a0123456789876543210 a0123456789876543210 arg) => - ZipWithSym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 - type instance Apply (ZipWithSym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ZipWithSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (ZipWithSym1 a0123456789876543210) where - suppressUnusedWarnings = snd (((,) ZipWithSym1KindInference) ()) - data ZipWithSym1 (a0123456789876543210 :: (~>) a0123456789876543210 ((~>) b0123456789876543210 c0123456789876543210)) :: (~>) [a0123456789876543210] ((~>) [b0123456789876543210] [c0123456789876543210]) + FooSym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (FooSym1 a0123456789876543210) arg) (FooSym2 a0123456789876543210 arg) => + FooSym1 a0123456789876543210 a0123456789876543210 + type instance Apply (FooSym1 a0123456789876543210) a0123456789876543210 = FooSym2 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (FooSym2 a0123456789876543210 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) FooSym2KindInference) ()) + data FooSym2 (a0123456789876543210 :: (~>) ((~>) a0123456789876543210 b0123456789876543210) ((~>) a0123456789876543210 b0123456789876543210)) (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) :: (~>) a0123456789876543210 b0123456789876543210 where - ZipWithSym1KindInference :: forall a0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply (ZipWithSym1 a0123456789876543210) arg) (ZipWithSym2 a0123456789876543210 arg) => - ZipWithSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (ZipWithSym1 a0123456789876543210) a0123456789876543210 = ZipWithSym2 a0123456789876543210 a0123456789876543210 + FooSym2KindInference :: forall a0123456789876543210 + a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (FooSym2 a0123456789876543210 a0123456789876543210) arg) (FooSym3 a0123456789876543210 a0123456789876543210 arg) => + FooSym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type instance Apply (FooSym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = FooSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type FooSym3 (a0123456789876543210 :: (~>) ((~>) a0123456789876543210 b0123456789876543210) ((~>) a0123456789876543210 b0123456789876543210)) (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) (a0123456789876543210 :: a0123456789876543210) = + Foo a0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings ZipWithSym0 where suppressUnusedWarnings = snd (((,) ZipWithSym0KindInference) ()) data ZipWithSym0 :: forall a0123456789876543210 @@ -260,17 +239,27 @@ Singletons/HigherOrder.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply ZipWithSym0 arg) (ZipWithSym1 arg) => ZipWithSym0 a0123456789876543210 type instance Apply ZipWithSym0 a0123456789876543210 = ZipWithSym1 a0123456789876543210 - type LiftMaybeSym2 (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) (a0123456789876543210 :: Maybe a0123456789876543210) = - LiftMaybe a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (LiftMaybeSym1 a0123456789876543210) where - suppressUnusedWarnings = snd (((,) LiftMaybeSym1KindInference) ()) - data LiftMaybeSym1 (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) :: (~>) (Maybe a0123456789876543210) (Maybe b0123456789876543210) + instance SuppressUnusedWarnings (ZipWithSym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) ZipWithSym1KindInference) ()) + data ZipWithSym1 (a0123456789876543210 :: (~>) a0123456789876543210 ((~>) b0123456789876543210 c0123456789876543210)) :: (~>) [a0123456789876543210] ((~>) [b0123456789876543210] [c0123456789876543210]) where - LiftMaybeSym1KindInference :: forall a0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply (LiftMaybeSym1 a0123456789876543210) arg) (LiftMaybeSym2 a0123456789876543210 arg) => - LiftMaybeSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (LiftMaybeSym1 a0123456789876543210) a0123456789876543210 = LiftMaybeSym2 a0123456789876543210 a0123456789876543210 + ZipWithSym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ZipWithSym1 a0123456789876543210) arg) (ZipWithSym2 a0123456789876543210 arg) => + ZipWithSym1 a0123456789876543210 a0123456789876543210 + type instance Apply (ZipWithSym1 a0123456789876543210) a0123456789876543210 = ZipWithSym2 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (ZipWithSym2 a0123456789876543210 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) ZipWithSym2KindInference) ()) + data ZipWithSym2 (a0123456789876543210 :: (~>) a0123456789876543210 ((~>) b0123456789876543210 c0123456789876543210)) (a0123456789876543210 :: [a0123456789876543210]) :: (~>) [b0123456789876543210] [c0123456789876543210] + where + ZipWithSym2KindInference :: forall a0123456789876543210 + a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ZipWithSym2 a0123456789876543210 a0123456789876543210) arg) (ZipWithSym3 a0123456789876543210 a0123456789876543210 arg) => + ZipWithSym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type instance Apply (ZipWithSym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ZipWithSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type ZipWithSym3 (a0123456789876543210 :: (~>) a0123456789876543210 ((~>) b0123456789876543210 c0123456789876543210)) (a0123456789876543210 :: [a0123456789876543210]) (a0123456789876543210 :: [b0123456789876543210]) = + ZipWith a0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings LiftMaybeSym0 where suppressUnusedWarnings = snd (((,) LiftMaybeSym0KindInference) ()) data LiftMaybeSym0 :: forall a0123456789876543210 @@ -281,17 +270,17 @@ Singletons/HigherOrder.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply LiftMaybeSym0 arg) (LiftMaybeSym1 arg) => LiftMaybeSym0 a0123456789876543210 type instance Apply LiftMaybeSym0 a0123456789876543210 = LiftMaybeSym1 a0123456789876543210 - type MapSym2 (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) (a0123456789876543210 :: [a0123456789876543210]) = - Map a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (MapSym1 a0123456789876543210) where - suppressUnusedWarnings = snd (((,) MapSym1KindInference) ()) - data MapSym1 (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) :: (~>) [a0123456789876543210] [b0123456789876543210] + instance SuppressUnusedWarnings (LiftMaybeSym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) LiftMaybeSym1KindInference) ()) + data LiftMaybeSym1 (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) :: (~>) (Maybe a0123456789876543210) (Maybe b0123456789876543210) where - MapSym1KindInference :: forall a0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply (MapSym1 a0123456789876543210) arg) (MapSym2 a0123456789876543210 arg) => - MapSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (MapSym1 a0123456789876543210) a0123456789876543210 = MapSym2 a0123456789876543210 a0123456789876543210 + LiftMaybeSym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (LiftMaybeSym1 a0123456789876543210) arg) (LiftMaybeSym2 a0123456789876543210 arg) => + LiftMaybeSym1 a0123456789876543210 a0123456789876543210 + type instance Apply (LiftMaybeSym1 a0123456789876543210) a0123456789876543210 = LiftMaybeSym2 a0123456789876543210 a0123456789876543210 + type LiftMaybeSym2 (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) (a0123456789876543210 :: Maybe a0123456789876543210) = + LiftMaybe a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings MapSym0 where suppressUnusedWarnings = snd (((,) MapSym0KindInference) ()) data MapSym0 :: forall a0123456789876543210 b0123456789876543210. @@ -301,6 +290,17 @@ Singletons/HigherOrder.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply MapSym0 arg) (MapSym1 arg) => MapSym0 a0123456789876543210 type instance Apply MapSym0 a0123456789876543210 = MapSym1 a0123456789876543210 + instance SuppressUnusedWarnings (MapSym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) MapSym1KindInference) ()) + data MapSym1 (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) :: (~>) [a0123456789876543210] [b0123456789876543210] + where + MapSym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (MapSym1 a0123456789876543210) arg) (MapSym2 a0123456789876543210 arg) => + MapSym1 a0123456789876543210 a0123456789876543210 + type instance Apply (MapSym1 a0123456789876543210) a0123456789876543210 = MapSym2 a0123456789876543210 a0123456789876543210 + type MapSym2 (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) (a0123456789876543210 :: [a0123456789876543210]) = + Map a0123456789876543210 a0123456789876543210 type family Etad (a :: [Nat]) (a :: [Bool]) :: [Nat] where Etad a_0123456789876543210 a_0123456789876543210 = Apply (Apply (Apply ZipWithSym0 (Apply (Apply Lambda_0123456789876543210Sym0 a_0123456789876543210) a_0123456789876543210)) a_0123456789876543210) a_0123456789876543210 type family Splunge (a :: [Nat]) (a :: [Bool]) :: [Nat] where diff --git a/tests/compile-and-dump/Singletons/LambdaCase.golden b/tests/compile-and-dump/Singletons/LambdaCase.golden index 8d1148b2..a0cffb62 100644 --- a/tests/compile-and-dump/Singletons/LambdaCase.golden +++ b/tests/compile-and-dump/Singletons/LambdaCase.golden @@ -33,19 +33,15 @@ Singletons/LambdaCase.hs:(0,0)-(0,0): Splicing declarations Case_0123456789876543210 x_0123456789876543210 a b '(p, _) = p type family Lambda_0123456789876543210 a b t where Lambda_0123456789876543210 a b x_0123456789876543210 = Case_0123456789876543210 x_0123456789876543210 a b x_0123456789876543210 - type Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 t0123456789876543210 = - Lambda_0123456789876543210 a0123456789876543210 b0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 b0123456789876543210 a0123456789876543210) where + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) - data Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210 t0123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 a0123456789876543210 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_0123456789876543210Sym3 b0123456789876543210 a0123456789876543210 t0123456789876543210 + 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 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) @@ -56,22 +52,33 @@ Singletons/LambdaCase.hs:(0,0)-(0,0): Splicing declarations 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 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) - data Lambda_0123456789876543210Sym0 a0123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210 t0123456789876543210 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 + 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 a0123456789876543210 b0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 t0123456789876543210 + type Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 a0123456789876543210 b0123456789876543210 t0123456789876543210 type family Case_0123456789876543210 x_0123456789876543210 d t where Case_0123456789876543210 x_0123456789876543210 d ('Just y) = y Case_0123456789876543210 x_0123456789876543210 d 'Nothing = d type family Lambda_0123456789876543210 d t where Lambda_0123456789876543210 d x_0123456789876543210 = Case_0123456789876543210 x_0123456789876543210 d x_0123456789876543210 - type Lambda_0123456789876543210Sym2 d0123456789876543210 t0123456789876543210 = - Lambda_0123456789876543210 d0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 d0123456789876543210 + where + Lambda_0123456789876543210Sym0KindInference :: forall d0123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 d0123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 d0123456789876543210 = Lambda_0123456789876543210Sym1 d0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 d0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) @@ -82,6 +89,13 @@ Singletons/LambdaCase.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Lambda_0123456789876543210Sym1 d0123456789876543210) arg) (Lambda_0123456789876543210Sym2 d0123456789876543210 arg) => Lambda_0123456789876543210Sym1 d0123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 d0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym2 d0123456789876543210 t0123456789876543210 + type Lambda_0123456789876543210Sym2 d0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 d0123456789876543210 t0123456789876543210 + type family Case_0123456789876543210 x_0123456789876543210 d x t where + Case_0123456789876543210 x_0123456789876543210 d x ('Just y) = y + Case_0123456789876543210 x_0123456789876543210 d x 'Nothing = d + type family Lambda_0123456789876543210 d x t where + Lambda_0123456789876543210 d x x_0123456789876543210 = Case_0123456789876543210 x_0123456789876543210 d x x_0123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) @@ -91,24 +105,6 @@ Singletons/LambdaCase.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 d0123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 d0123456789876543210 = Lambda_0123456789876543210Sym1 d0123456789876543210 - type family Case_0123456789876543210 x_0123456789876543210 d x t where - Case_0123456789876543210 x_0123456789876543210 d x ('Just y) = y - Case_0123456789876543210 x_0123456789876543210 d x 'Nothing = d - type family Lambda_0123456789876543210 d x t where - Lambda_0123456789876543210 d x x_0123456789876543210 = Case_0123456789876543210 x_0123456789876543210 d x x_0123456789876543210 - type Lambda_0123456789876543210Sym3 d0123456789876543210 x0123456789876543210 t0123456789876543210 = - Lambda_0123456789876543210 d0123456789876543210 x0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 x0123456789876543210 d0123456789876543210) where - suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) - data Lambda_0123456789876543210Sym2 d0123456789876543210 x0123456789876543210 t0123456789876543210 - where - Lambda_0123456789876543210Sym2KindInference :: forall d0123456789876543210 - x0123456789876543210 - t0123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym2 d0123456789876543210 x0123456789876543210) arg) (Lambda_0123456789876543210Sym3 d0123456789876543210 x0123456789876543210 arg) => - Lambda_0123456789876543210Sym2 d0123456789876543210 x0123456789876543210 t0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 d0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym3 x0123456789876543210 d0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 d0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) @@ -119,27 +115,19 @@ Singletons/LambdaCase.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Lambda_0123456789876543210Sym1 d0123456789876543210) arg) (Lambda_0123456789876543210Sym2 d0123456789876543210 arg) => Lambda_0123456789876543210Sym1 d0123456789876543210 x0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 d0123456789876543210) x0123456789876543210 = Lambda_0123456789876543210Sym2 d0123456789876543210 x0123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 d0123456789876543210 x0123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) - data Lambda_0123456789876543210Sym0 d0123456789876543210 - where - Lambda_0123456789876543210Sym0KindInference :: forall d0123456789876543210 - arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 d0123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 d0123456789876543210 = Lambda_0123456789876543210Sym1 d0123456789876543210 - type Foo3Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = - Foo3 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (Foo3Sym1 a0123456789876543210) where - suppressUnusedWarnings = snd (((,) Foo3Sym1KindInference) ()) - data Foo3Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. - (~>) b0123456789876543210 a0123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 d0123456789876543210 x0123456789876543210 t0123456789876543210 where - Foo3Sym1KindInference :: forall a0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply (Foo3Sym1 a0123456789876543210) arg) (Foo3Sym2 a0123456789876543210 arg) => - Foo3Sym1 a0123456789876543210 a0123456789876543210 - type instance Apply (Foo3Sym1 a0123456789876543210) a0123456789876543210 = Foo3Sym2 a0123456789876543210 a0123456789876543210 + Lambda_0123456789876543210Sym2KindInference :: forall d0123456789876543210 + x0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym2 d0123456789876543210 x0123456789876543210) arg) (Lambda_0123456789876543210Sym3 d0123456789876543210 x0123456789876543210 arg) => + Lambda_0123456789876543210Sym2 d0123456789876543210 x0123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 d0123456789876543210 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym3 d0123456789876543210 x0123456789876543210 t0123456789876543210 + type Lambda_0123456789876543210Sym3 d0123456789876543210 x0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 d0123456789876543210 x0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings Foo3Sym0 where suppressUnusedWarnings = snd (((,) Foo3Sym0KindInference) ()) data Foo3Sym0 :: forall a0123456789876543210 b0123456789876543210. @@ -149,17 +137,18 @@ Singletons/LambdaCase.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Foo3Sym0 arg) (Foo3Sym1 arg) => Foo3Sym0 a0123456789876543210 type instance Apply Foo3Sym0 a0123456789876543210 = Foo3Sym1 a0123456789876543210 - type Foo2Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: Maybe a0123456789876543210) = - Foo2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (Foo2Sym1 a0123456789876543210) where - suppressUnusedWarnings = snd (((,) Foo2Sym1KindInference) ()) - data Foo2Sym1 (a0123456789876543210 :: a0123456789876543210) :: (~>) (Maybe a0123456789876543210) a0123456789876543210 + instance SuppressUnusedWarnings (Foo3Sym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) Foo3Sym1KindInference) ()) + data Foo3Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. + (~>) b0123456789876543210 a0123456789876543210 where - Foo2Sym1KindInference :: forall a0123456789876543210 + Foo3Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 - arg. SameKind (Apply (Foo2Sym1 a0123456789876543210) arg) (Foo2Sym2 a0123456789876543210 arg) => - Foo2Sym1 a0123456789876543210 a0123456789876543210 - type instance Apply (Foo2Sym1 a0123456789876543210) a0123456789876543210 = Foo2Sym2 a0123456789876543210 a0123456789876543210 + arg. SameKind (Apply (Foo3Sym1 a0123456789876543210) arg) (Foo3Sym2 a0123456789876543210 arg) => + Foo3Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Foo3Sym1 a0123456789876543210) a0123456789876543210 = Foo3Sym2 a0123456789876543210 a0123456789876543210 + type Foo3Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = + Foo3 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Foo2Sym0 where suppressUnusedWarnings = snd (((,) Foo2Sym0KindInference) ()) data Foo2Sym0 :: forall a0123456789876543210. @@ -169,17 +158,17 @@ Singletons/LambdaCase.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Foo2Sym0 arg) (Foo2Sym1 arg) => Foo2Sym0 a0123456789876543210 type instance Apply Foo2Sym0 a0123456789876543210 = Foo2Sym1 a0123456789876543210 - type Foo1Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: Maybe a0123456789876543210) = - Foo1 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (Foo1Sym1 a0123456789876543210) where - suppressUnusedWarnings = snd (((,) Foo1Sym1KindInference) ()) - data Foo1Sym1 (a0123456789876543210 :: a0123456789876543210) :: (~>) (Maybe a0123456789876543210) a0123456789876543210 + instance SuppressUnusedWarnings (Foo2Sym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) Foo2Sym1KindInference) ()) + data Foo2Sym1 (a0123456789876543210 :: a0123456789876543210) :: (~>) (Maybe a0123456789876543210) a0123456789876543210 where - Foo1Sym1KindInference :: forall a0123456789876543210 + Foo2Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 - arg. SameKind (Apply (Foo1Sym1 a0123456789876543210) arg) (Foo1Sym2 a0123456789876543210 arg) => - Foo1Sym1 a0123456789876543210 a0123456789876543210 - type instance Apply (Foo1Sym1 a0123456789876543210) a0123456789876543210 = Foo1Sym2 a0123456789876543210 a0123456789876543210 + arg. SameKind (Apply (Foo2Sym1 a0123456789876543210) arg) (Foo2Sym2 a0123456789876543210 arg) => + Foo2Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Foo2Sym1 a0123456789876543210) a0123456789876543210 = Foo2Sym2 a0123456789876543210 a0123456789876543210 + type Foo2Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: Maybe a0123456789876543210) = + Foo2 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Foo1Sym0 where suppressUnusedWarnings = snd (((,) Foo1Sym0KindInference) ()) data Foo1Sym0 :: forall a0123456789876543210. @@ -189,6 +178,17 @@ Singletons/LambdaCase.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Foo1Sym0 arg) (Foo1Sym1 arg) => Foo1Sym0 a0123456789876543210 type instance Apply Foo1Sym0 a0123456789876543210 = Foo1Sym1 a0123456789876543210 + instance SuppressUnusedWarnings (Foo1Sym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) Foo1Sym1KindInference) ()) + data Foo1Sym1 (a0123456789876543210 :: a0123456789876543210) :: (~>) (Maybe a0123456789876543210) a0123456789876543210 + where + Foo1Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Foo1Sym1 a0123456789876543210) arg) (Foo1Sym2 a0123456789876543210 arg) => + Foo1Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Foo1Sym1 a0123456789876543210) a0123456789876543210 = Foo1Sym2 a0123456789876543210 a0123456789876543210 + type Foo1Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: Maybe a0123456789876543210) = + Foo1 a0123456789876543210 a0123456789876543210 type family Foo3 (a :: a) (a :: b) :: a where Foo3 a b = Apply (Apply (Apply Lambda_0123456789876543210Sym0 a) b) (Apply (Apply Tuple2Sym0 a) b) type family Foo2 (a :: a) (a :: Maybe a) :: a where diff --git a/tests/compile-and-dump/Singletons/Lambdas.golden b/tests/compile-and-dump/Singletons/Lambdas.golden index 43e9b9f5..fd90d051 100644 --- a/tests/compile-and-dump/Singletons/Lambdas.golden +++ b/tests/compile-and-dump/Singletons/Lambdas.golden @@ -40,8 +40,15 @@ Singletons/Lambdas.hs:(0,0)-(0,0): Splicing declarations 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 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 instance SuppressUnusedWarnings (FooSym1 t0123456789876543210) where suppressUnusedWarnings = snd (((,) FooSym1KindInference) ()) data FooSym1 (t0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. @@ -52,21 +59,21 @@ Singletons/Lambdas.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (FooSym1 t0123456789876543210) arg) (FooSym2 t0123456789876543210 arg) => FooSym1 t0123456789876543210 t0123456789876543210 type instance Apply (FooSym1 t0123456789876543210) t0123456789876543210 = FooSym2 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 FooSym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) = + Foo t0123456789876543210 t0123456789876543210 type family Case_0123456789876543210 arg_0123456789876543210 x t where Case_0123456789876543210 arg_0123456789876543210 x (Foo a _) = a type family Lambda_0123456789876543210 x t where Lambda_0123456789876543210 x arg_0123456789876543210 = Case_0123456789876543210 arg_0123456789876543210 x arg_0123456789876543210 - type Lambda_0123456789876543210Sym2 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 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) @@ -77,6 +84,12 @@ Singletons/Lambdas.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) => Lambda_0123456789876543210Sym1 x0123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym2 x0123456789876543210 t0123456789876543210 + type Lambda_0123456789876543210Sym2 x0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 x0123456789876543210 t0123456789876543210 + type family Case_0123456789876543210 arg_0123456789876543210 x y t where + Case_0123456789876543210 arg_0123456789876543210 x y '(_, b) = b + type family Lambda_0123456789876543210 x y t where + Lambda_0123456789876543210 x y arg_0123456789876543210 = Case_0123456789876543210 arg_0123456789876543210 x y arg_0123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) @@ -86,23 +99,6 @@ Singletons/Lambdas.hs:(0,0)-(0,0): Splicing declarations 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 arg_0123456789876543210 x y t where - Case_0123456789876543210 arg_0123456789876543210 x y '(_, b) = b - type family Lambda_0123456789876543210 x y t where - Lambda_0123456789876543210 x y arg_0123456789876543210 = Case_0123456789876543210 arg_0123456789876543210 x y 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_0123456789876543210Sym3 y0123456789876543210 x0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) @@ -113,6 +109,23 @@ Singletons/Lambdas.hs:(0,0)-(0,0): Splicing declarations 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_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210) 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 x0123456789876543210 y0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 t0123456789876543210 + type Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 x0123456789876543210 y0123456789876543210 t0123456789876543210 + type family Case_0123456789876543210 arg_0123456789876543210 x a b t where + Case_0123456789876543210 arg_0123456789876543210 x a b _ = x + type family Lambda_0123456789876543210 x a b t where + Lambda_0123456789876543210 x a b arg_0123456789876543210 = Case_0123456789876543210 arg_0123456789876543210 x a b arg_0123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) @@ -122,25 +135,17 @@ Singletons/Lambdas.hs:(0,0)-(0,0): Splicing declarations 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 arg_0123456789876543210 x a b t where - Case_0123456789876543210 arg_0123456789876543210 x a b _ = x - type family Lambda_0123456789876543210 x a b t where - Lambda_0123456789876543210 x a b arg_0123456789876543210 = Case_0123456789876543210 arg_0123456789876543210 x a b arg_0123456789876543210 - type Lambda_0123456789876543210Sym4 x0123456789876543210 a0123456789876543210 b0123456789876543210 t0123456789876543210 = - Lambda_0123456789876543210 x0123456789876543210 a0123456789876543210 b0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 b0123456789876543210 a0123456789876543210 x0123456789876543210) where + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) - data Lambda_0123456789876543210Sym3 x0123456789876543210 a0123456789876543210 b0123456789876543210 t0123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) + data Lambda_0123456789876543210Sym1 x0123456789876543210 a0123456789876543210 where - Lambda_0123456789876543210Sym3KindInference :: forall x0123456789876543210 + Lambda_0123456789876543210Sym1KindInference :: forall x0123456789876543210 a0123456789876543210 - b0123456789876543210 - t0123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym3 x0123456789876543210 a0123456789876543210 b0123456789876543210) arg) (Lambda_0123456789876543210Sym4 x0123456789876543210 a0123456789876543210 b0123456789876543210 arg) => - Lambda_0123456789876543210Sym3 x0123456789876543210 a0123456789876543210 b0123456789876543210 t0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym3 b0123456789876543210 a0123456789876543210 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym4 b0123456789876543210 a0123456789876543210 x0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 a0123456789876543210 x0123456789876543210) where + arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) => + Lambda_0123456789876543210Sym1 x0123456789876543210 a0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) a0123456789876543210 = Lambda_0123456789876543210Sym2 x0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 x0123456789876543210 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) data Lambda_0123456789876543210Sym2 x0123456789876543210 a0123456789876543210 b0123456789876543210 @@ -150,41 +155,32 @@ Singletons/Lambdas.hs:(0,0)-(0,0): Splicing declarations b0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 a0123456789876543210) arg) (Lambda_0123456789876543210Sym3 x0123456789876543210 a0123456789876543210 arg) => Lambda_0123456789876543210Sym2 x0123456789876543210 a0123456789876543210 b0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 a0123456789876543210 x0123456789876543210) b0123456789876543210 = Lambda_0123456789876543210Sym3 a0123456789876543210 x0123456789876543210 b0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where + type instance Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 a0123456789876543210) b0123456789876543210 = Lambda_0123456789876543210Sym3 x0123456789876543210 a0123456789876543210 b0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 x0123456789876543210 a0123456789876543210 b0123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) - data Lambda_0123456789876543210Sym1 x0123456789876543210 a0123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) + data Lambda_0123456789876543210Sym3 x0123456789876543210 a0123456789876543210 b0123456789876543210 t0123456789876543210 where - Lambda_0123456789876543210Sym1KindInference :: forall x0123456789876543210 + Lambda_0123456789876543210Sym3KindInference :: forall x0123456789876543210 a0123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) => - Lambda_0123456789876543210Sym1 x0123456789876543210 a0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) a0123456789876543210 = Lambda_0123456789876543210Sym2 x0123456789876543210 a0123456789876543210 + b0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym3 x0123456789876543210 a0123456789876543210 b0123456789876543210) arg) (Lambda_0123456789876543210Sym4 x0123456789876543210 a0123456789876543210 b0123456789876543210 arg) => + Lambda_0123456789876543210Sym3 x0123456789876543210 a0123456789876543210 b0123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym3 x0123456789876543210 a0123456789876543210 b0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym4 x0123456789876543210 a0123456789876543210 b0123456789876543210 t0123456789876543210 + type Lambda_0123456789876543210Sym4 x0123456789876543210 a0123456789876543210 b0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 x0123456789876543210 a0123456789876543210 b0123456789876543210 t0123456789876543210 + type family Lambda_0123456789876543210 a b t where + Lambda_0123456789876543210 a b x = Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) a) b instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) - data Lambda_0123456789876543210Sym0 x0123456789876543210 + data Lambda_0123456789876543210Sym0 a0123456789876543210 where - Lambda_0123456789876543210Sym0KindInference :: forall x0123456789876543210 + Lambda_0123456789876543210Sym0KindInference :: forall a0123456789876543210 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 b t where - Lambda_0123456789876543210 a b x = Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) a) b - 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_0123456789876543210Sym3 b0123456789876543210 a0123456789876543210 t0123456789876543210 + Lambda_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 a0123456789876543210 = Lambda_0123456789876543210Sym1 a0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) @@ -195,30 +191,30 @@ Singletons/Lambdas.hs:(0,0)-(0,0): Splicing declarations 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 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) - data Lambda_0123456789876543210Sym0 a0123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210 t0123456789876543210 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 + 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 a0123456789876543210 b0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 t0123456789876543210 + type Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 a0123456789876543210 b0123456789876543210 t0123456789876543210 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 + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) - data Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 t0123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 x0123456789876543210 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_0123456789876543210Sym3 y0123456789876543210 x0123456789876543210 t0123456789876543210 + 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 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) @@ -229,6 +225,24 @@ Singletons/Lambdas.hs:(0,0)-(0,0): Splicing declarations 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_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210) 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 x0123456789876543210 y0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 t0123456789876543210 + type Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 x0123456789876543210 y0123456789876543210 t0123456789876543210 + type family Case_0123456789876543210 arg_0123456789876543210 arg_0123456789876543210 x y z t where + Case_0123456789876543210 arg_0123456789876543210 arg_0123456789876543210 x y z '(_, + _) = x + type family Lambda_0123456789876543210 x y z t t where + Lambda_0123456789876543210 x y z arg_0123456789876543210 arg_0123456789876543210 = Case_0123456789876543210 arg_0123456789876543210 arg_0123456789876543210 x y z (Apply (Apply Tuple2Sym0 arg_0123456789876543210) arg_0123456789876543210) instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) @@ -238,27 +252,28 @@ Singletons/Lambdas.hs:(0,0)-(0,0): Splicing declarations 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 arg_0123456789876543210 arg_0123456789876543210 x y z t where - Case_0123456789876543210 arg_0123456789876543210 arg_0123456789876543210 x y z '(_, - _) = x - type family Lambda_0123456789876543210 x y z t t where - Lambda_0123456789876543210 x y z arg_0123456789876543210 arg_0123456789876543210 = Case_0123456789876543210 arg_0123456789876543210 arg_0123456789876543210 x y z (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 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym4KindInference) ()) - data Lambda_0123456789876543210Sym4 x0123456789876543210 y0123456789876543210 z0123456789876543210 t0123456789876543210 t0123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) + data Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 where - Lambda_0123456789876543210Sym4KindInference :: forall x0123456789876543210 + 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_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 z0123456789876543210 + where + Lambda_0123456789876543210Sym2KindInference :: 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_0123456789876543210Sym5 t0123456789876543210 z0123456789876543210 y0123456789876543210 x0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 z0123456789876543210 y0123456789876543210 x0123456789876543210) where + arg. SameKind (Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210) arg) (Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 arg) => + Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 z0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210) z0123456789876543210 = Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 z0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 z0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) data Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 z0123456789876543210 t0123456789876543210 @@ -269,28 +284,24 @@ Singletons/Lambdas.hs:(0,0)-(0,0): Splicing declarations 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 + type instance Apply (Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 z0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym4 x0123456789876543210 y0123456789876543210 z0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 x0123456789876543210 y0123456789876543210 z0123456789876543210 t0123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) - data Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 z0123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym4KindInference) ()) + data Lambda_0123456789876543210Sym4 x0123456789876543210 y0123456789876543210 z0123456789876543210 t0123456789876543210 t0123456789876543210 where - Lambda_0123456789876543210Sym2KindInference :: forall x0123456789876543210 + Lambda_0123456789876543210Sym4KindInference :: 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 + 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 x0123456789876543210 y0123456789876543210 z0123456789876543210 t0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym5 x0123456789876543210 y0123456789876543210 z0123456789876543210 t0123456789876543210 t0123456789876543210 + type Lambda_0123456789876543210Sym5 x0123456789876543210 y0123456789876543210 z0123456789876543210 t0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 x0123456789876543210 y0123456789876543210 z0123456789876543210 t0123456789876543210 t0123456789876543210 + type family Lambda_0123456789876543210 x t where + Lambda_0123456789876543210 x y = y instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) @@ -300,10 +311,6 @@ Singletons/Lambdas.hs:(0,0)-(0,0): Splicing declarations 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) ()) @@ -314,6 +321,12 @@ Singletons/Lambdas.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) => Lambda_0123456789876543210Sym1 x0123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym2 x0123456789876543210 t0123456789876543210 + type Lambda_0123456789876543210Sym2 x0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 x0123456789876543210 t0123456789876543210 + type family Case_0123456789876543210 arg_0123456789876543210 x y t where + Case_0123456789876543210 arg_0123456789876543210 x y _ = x + type family Lambda_0123456789876543210 x y t where + Lambda_0123456789876543210 x y arg_0123456789876543210 = Case_0123456789876543210 arg_0123456789876543210 x y arg_0123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) @@ -323,23 +336,6 @@ Singletons/Lambdas.hs:(0,0)-(0,0): Splicing declarations 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 arg_0123456789876543210 x y t where - Case_0123456789876543210 arg_0123456789876543210 x y _ = x - type family Lambda_0123456789876543210 x y t where - Lambda_0123456789876543210 x y arg_0123456789876543210 = Case_0123456789876543210 arg_0123456789876543210 x y 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_0123456789876543210Sym3 y0123456789876543210 x0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) @@ -350,6 +346,23 @@ Singletons/Lambdas.hs:(0,0)-(0,0): Splicing declarations 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_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210) 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 x0123456789876543210 y0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 t0123456789876543210 + type Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 x0123456789876543210 y0123456789876543210 t0123456789876543210 + type family Case_0123456789876543210 arg_0123456789876543210 x a_0123456789876543210 t where + Case_0123456789876543210 arg_0123456789876543210 x a_0123456789876543210 _ = x + type family Lambda_0123456789876543210 x a_0123456789876543210 t where + Lambda_0123456789876543210 x a_0123456789876543210 arg_0123456789876543210 = Case_0123456789876543210 arg_0123456789876543210 x a_0123456789876543210 arg_0123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) @@ -359,23 +372,6 @@ Singletons/Lambdas.hs:(0,0)-(0,0): Splicing declarations 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 arg_0123456789876543210 x a_0123456789876543210 t where - Case_0123456789876543210 arg_0123456789876543210 x a_0123456789876543210 _ = x - type family Lambda_0123456789876543210 x a_0123456789876543210 t where - Lambda_0123456789876543210 x a_0123456789876543210 arg_0123456789876543210 = Case_0123456789876543210 arg_0123456789876543210 x 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_0123456789876543210Sym3 a_01234567898765432100123456789876543210 x0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) @@ -386,31 +382,40 @@ Singletons/Lambdas.hs:(0,0)-(0,0): Splicing declarations 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_0123456789876543210Sym2 x0123456789876543210 a_01234567898765432100123456789876543210) 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 x0123456789876543210 a_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym3 x0123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + type Lambda_0123456789876543210Sym3 x0123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + type family Lambda_0123456789876543210 a_0123456789876543210 a_0123456789876543210 t t where + Lambda_0123456789876543210 a_0123456789876543210 a_0123456789876543210 x y = x instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) - data Lambda_0123456789876543210Sym0 x0123456789876543210 + data Lambda_0123456789876543210Sym0 a_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym0KindInference :: forall x0123456789876543210 + Lambda_0123456789876543210Sym0KindInference :: forall a_01234567898765432100123456789876543210 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 + Lambda_0123456789876543210Sym0 a_01234567898765432100123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) - data Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) + data Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym3KindInference :: forall a_01234567898765432100123456789876543210 + Lambda_0123456789876543210Sym1KindInference :: 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_0123456789876543210Sym4 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + 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_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) @@ -422,27 +427,20 @@ Singletons/Lambdas.hs:(0,0)-(0,0): Splicing declarations 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 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) - data Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) + data Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 where - Lambda_0123456789876543210Sym1KindInference :: forall a_01234567898765432100123456789876543210 + Lambda_0123456789876543210Sym3KindInference :: 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 + 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 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 + type Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings Foo8Sym0 where suppressUnusedWarnings = snd (((,) Foo8Sym0KindInference) ()) data Foo8Sym0 :: forall a0123456789876543210 b0123456789876543210. @@ -452,18 +450,8 @@ Singletons/Lambdas.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Foo8Sym0 arg) (Foo8Sym1 arg) => Foo8Sym0 a0123456789876543210 type instance Apply Foo8Sym0 a0123456789876543210 = Foo8Sym1 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 = Foo7Sym2 a0123456789876543210 a0123456789876543210 + type Foo8Sym1 (a0123456789876543210 :: Foo a0123456789876543210 b0123456789876543210) = + Foo8 a0123456789876543210 instance SuppressUnusedWarnings Foo7Sym0 where suppressUnusedWarnings = snd (((,) Foo7Sym0KindInference) ()) data Foo7Sym0 :: forall a0123456789876543210 b0123456789876543210. @@ -473,18 +461,18 @@ Singletons/Lambdas.hs:(0,0)-(0,0): Splicing declarations 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 + instance SuppressUnusedWarnings (Foo7Sym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) Foo7Sym1KindInference) ()) + data Foo7Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. + (~>) b0123456789876543210 b0123456789876543210 where - Foo6Sym1KindInference :: forall a0123456789876543210 + Foo7Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 - arg. SameKind (Apply (Foo6Sym1 a0123456789876543210) arg) (Foo6Sym2 a0123456789876543210 arg) => - Foo6Sym1 a0123456789876543210 a0123456789876543210 - type instance Apply (Foo6Sym1 a0123456789876543210) a0123456789876543210 = Foo6Sym2 a0123456789876543210 a0123456789876543210 + arg. SameKind (Apply (Foo7Sym1 a0123456789876543210) arg) (Foo7Sym2 a0123456789876543210 arg) => + Foo7Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Foo7Sym1 a0123456789876543210) a0123456789876543210 = Foo7Sym2 a0123456789876543210 a0123456789876543210 + type Foo7Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = + Foo7 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Foo6Sym0 where suppressUnusedWarnings = snd (((,) Foo6Sym0KindInference) ()) data Foo6Sym0 :: forall a0123456789876543210 b0123456789876543210. @@ -494,18 +482,18 @@ Singletons/Lambdas.hs:(0,0)-(0,0): Splicing declarations 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 + instance SuppressUnusedWarnings (Foo6Sym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) Foo6Sym1KindInference) ()) + data Foo6Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. + (~>) b0123456789876543210 a0123456789876543210 where - Foo5Sym1KindInference :: forall a0123456789876543210 + Foo6Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 - arg. SameKind (Apply (Foo5Sym1 a0123456789876543210) arg) (Foo5Sym2 a0123456789876543210 arg) => - Foo5Sym1 a0123456789876543210 a0123456789876543210 - type instance Apply (Foo5Sym1 a0123456789876543210) a0123456789876543210 = Foo5Sym2 a0123456789876543210 a0123456789876543210 + arg. SameKind (Apply (Foo6Sym1 a0123456789876543210) arg) (Foo6Sym2 a0123456789876543210 arg) => + Foo6Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Foo6Sym1 a0123456789876543210) a0123456789876543210 = Foo6Sym2 a0123456789876543210 a0123456789876543210 + type Foo6Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = + Foo6 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Foo5Sym0 where suppressUnusedWarnings = snd (((,) Foo5Sym0KindInference) ()) data Foo5Sym0 :: forall a0123456789876543210 b0123456789876543210. @@ -515,19 +503,29 @@ Singletons/Lambdas.hs:(0,0)-(0,0): Splicing declarations 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 + instance SuppressUnusedWarnings (Foo5Sym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) Foo5Sym1KindInference) ()) + data Foo5Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. + (~>) b0123456789876543210 b0123456789876543210 where - Foo4Sym2KindInference :: forall a0123456789876543210 - a0123456789876543210 + Foo5Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 - arg. SameKind (Apply (Foo4Sym2 a0123456789876543210 a0123456789876543210) arg) (Foo4Sym3 a0123456789876543210 a0123456789876543210 arg) => - Foo4Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 - type instance Apply (Foo4Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = Foo4Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 + arg. SameKind (Apply (Foo5Sym1 a0123456789876543210) arg) (Foo5Sym2 a0123456789876543210 arg) => + Foo5Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Foo5Sym1 a0123456789876543210) a0123456789876543210 = Foo5Sym2 a0123456789876543210 a0123456789876543210 + type Foo5Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = + Foo5 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 instance SuppressUnusedWarnings (Foo4Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Foo4Sym1KindInference) ()) data Foo4Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210 @@ -539,19 +537,19 @@ Singletons/Lambdas.hs:(0,0)-(0,0): Splicing declarations 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)) + instance SuppressUnusedWarnings (Foo4Sym2 a0123456789876543210 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) Foo4Sym2KindInference) ()) + data Foo4Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) :: forall c0123456789876543210. + (~>) 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 + 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 = Foo4Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type Foo4Sym3 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) (a0123456789876543210 :: c0123456789876543210) = + Foo4 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Foo3Sym0 where suppressUnusedWarnings = snd (((,) Foo3Sym0KindInference) ()) data Foo3Sym0 :: forall a0123456789876543210. @@ -561,8 +559,17 @@ Singletons/Lambdas.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Foo3Sym0 arg) (Foo3Sym1 arg) => Foo3Sym0 a0123456789876543210 type instance Apply Foo3Sym0 a0123456789876543210 = Foo3Sym1 a0123456789876543210 - type Foo2Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = - Foo2 a0123456789876543210 a0123456789876543210 + type Foo3Sym1 (a0123456789876543210 :: a0123456789876543210) = + Foo3 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 instance SuppressUnusedWarnings (Foo2Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Foo2Sym1KindInference) ()) data Foo2Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. @@ -573,17 +580,17 @@ Singletons/Lambdas.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Foo2Sym1 a0123456789876543210) arg) (Foo2Sym2 a0123456789876543210 arg) => Foo2Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Foo2Sym1 a0123456789876543210) a0123456789876543210 = Foo2Sym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings Foo2Sym0 where - suppressUnusedWarnings = snd (((,) Foo2Sym0KindInference) ()) - data Foo2Sym0 :: forall a0123456789876543210 b0123456789876543210. + type Foo2Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = + Foo2 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Foo1Sym0 where + suppressUnusedWarnings = snd (((,) Foo1Sym0KindInference) ()) + data Foo1Sym0 :: 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 + Foo1Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Foo1Sym0 arg) (Foo1Sym1 arg) => + Foo1Sym0 a0123456789876543210 + type instance Apply Foo1Sym0 a0123456789876543210 = Foo1Sym1 a0123456789876543210 instance SuppressUnusedWarnings (Foo1Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Foo1Sym1KindInference) ()) data Foo1Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. @@ -594,17 +601,17 @@ Singletons/Lambdas.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Foo1Sym1 a0123456789876543210) arg) (Foo1Sym2 a0123456789876543210 arg) => Foo1Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Foo1Sym1 a0123456789876543210) a0123456789876543210 = Foo1Sym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings Foo1Sym0 where - suppressUnusedWarnings = snd (((,) Foo1Sym0KindInference) ()) - data Foo1Sym0 :: forall a0123456789876543210 b0123456789876543210. + type Foo1Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = + Foo1 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Foo0Sym0 where + suppressUnusedWarnings = snd (((,) Foo0Sym0KindInference) ()) + data Foo0Sym0 :: 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 + Foo0Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Foo0Sym0 arg) (Foo0Sym1 arg) => + Foo0Sym0 a0123456789876543210 + type instance Apply Foo0Sym0 a0123456789876543210 = Foo0Sym1 a0123456789876543210 instance SuppressUnusedWarnings (Foo0Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Foo0Sym1KindInference) ()) data Foo0Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. @@ -615,15 +622,8 @@ Singletons/Lambdas.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Foo0Sym1 a0123456789876543210) arg) (Foo0Sym2 a0123456789876543210 arg) => Foo0Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Foo0Sym1 a0123456789876543210) a0123456789876543210 = Foo0Sym2 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 Foo0Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = + Foo0 a0123456789876543210 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 diff --git a/tests/compile-and-dump/Singletons/LambdasComprehensive.golden b/tests/compile-and-dump/Singletons/LambdasComprehensive.golden index 80b1a04e..53b0f410 100644 --- a/tests/compile-and-dump/Singletons/LambdasComprehensive.golden +++ b/tests/compile-and-dump/Singletons/LambdasComprehensive.golden @@ -14,8 +14,6 @@ Singletons/LambdasComprehensive.hs:(0,0)-(0,0): Splicing declarations bar = (map ((either_ pred) Succ)) [Left Zero, Right (Succ Zero)] type family Lambda_0123456789876543210 t where Lambda_0123456789876543210 x = Apply (Apply (Apply Either_Sym0 PredSym0) SuccSym0) x - type Lambda_0123456789876543210Sym1 t0123456789876543210 = - Lambda_0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) @@ -25,6 +23,8 @@ Singletons/LambdasComprehensive.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 t0123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 t0123456789876543210 = Lambda_0123456789876543210Sym1 t0123456789876543210 + type Lambda_0123456789876543210Sym1 t0123456789876543210 = + Lambda_0123456789876543210 t0123456789876543210 type BarSym0 = Bar type FooSym0 = Foo type family Bar :: [Nat] where diff --git a/tests/compile-and-dump/Singletons/LetStatements.golden b/tests/compile-and-dump/Singletons/LetStatements.golden index f22f8ae3..42dca9be 100644 --- a/tests/compile-and-dump/Singletons/LetStatements.golden +++ b/tests/compile-and-dump/Singletons/LetStatements.golden @@ -195,8 +195,6 @@ Singletons/LetStatements.hs:(0,0)-(0,0): Splicing declarations type family Case_0123456789876543210 x t where Case_0123456789876543210 x '(y_0123456789876543210, _) = y_0123456789876543210 - type Let0123456789876543210ZSym1 x0123456789876543210 = - Let0123456789876543210Z x0123456789876543210 instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where suppressUnusedWarnings = snd (((,) Let0123456789876543210ZSym0KindInference) ()) @@ -206,8 +204,8 @@ Singletons/LetStatements.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) => Let0123456789876543210ZSym0 x0123456789876543210 type instance Apply Let0123456789876543210ZSym0 x0123456789876543210 = Let0123456789876543210ZSym1 x0123456789876543210 - type Let0123456789876543210YSym1 x0123456789876543210 = - Let0123456789876543210Y x0123456789876543210 + type Let0123456789876543210ZSym1 x0123456789876543210 = + Let0123456789876543210Z x0123456789876543210 instance SuppressUnusedWarnings Let0123456789876543210YSym0 where suppressUnusedWarnings = snd (((,) Let0123456789876543210YSym0KindInference) ()) @@ -217,8 +215,8 @@ Singletons/LetStatements.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Let0123456789876543210YSym0 arg) (Let0123456789876543210YSym1 arg) => Let0123456789876543210YSym0 x0123456789876543210 type instance Apply Let0123456789876543210YSym0 x0123456789876543210 = Let0123456789876543210YSym1 x0123456789876543210 - type Let0123456789876543210X_0123456789876543210Sym1 x0123456789876543210 = - Let0123456789876543210X_0123456789876543210 x0123456789876543210 + type Let0123456789876543210YSym1 x0123456789876543210 = + Let0123456789876543210Y x0123456789876543210 instance SuppressUnusedWarnings Let0123456789876543210X_0123456789876543210Sym0 where suppressUnusedWarnings = snd @@ -230,14 +228,14 @@ Singletons/LetStatements.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Let0123456789876543210X_0123456789876543210Sym0 arg) (Let0123456789876543210X_0123456789876543210Sym1 arg) => Let0123456789876543210X_0123456789876543210Sym0 x0123456789876543210 type instance Apply Let0123456789876543210X_0123456789876543210Sym0 x0123456789876543210 = Let0123456789876543210X_0123456789876543210Sym1 x0123456789876543210 + type Let0123456789876543210X_0123456789876543210Sym1 x0123456789876543210 = + Let0123456789876543210X_0123456789876543210 x0123456789876543210 type family Let0123456789876543210Z x where Let0123456789876543210Z x = Case_0123456789876543210 x (Let0123456789876543210X_0123456789876543210Sym1 x) type family Let0123456789876543210Y x where Let0123456789876543210Y x = Case_0123456789876543210 x (Let0123456789876543210X_0123456789876543210Sym1 x) type family Let0123456789876543210X_0123456789876543210 x where Let0123456789876543210X_0123456789876543210 x = Apply (Apply Tuple2Sym0 (Apply SuccSym0 x)) x - type Let0123456789876543210BarSym1 x0123456789876543210 = - Let0123456789876543210Bar x0123456789876543210 instance SuppressUnusedWarnings Let0123456789876543210BarSym0 where suppressUnusedWarnings = snd (((,) Let0123456789876543210BarSym0KindInference) ()) @@ -247,21 +245,19 @@ Singletons/LetStatements.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Let0123456789876543210BarSym0 arg) (Let0123456789876543210BarSym1 arg) => Let0123456789876543210BarSym0 x0123456789876543210 type instance Apply Let0123456789876543210BarSym0 x0123456789876543210 = Let0123456789876543210BarSym1 x0123456789876543210 + type Let0123456789876543210BarSym1 x0123456789876543210 = + Let0123456789876543210Bar x0123456789876543210 type family Let0123456789876543210Bar x :: a where Let0123456789876543210Bar x = x - type (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$$) x0123456789876543210 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) = - (<<<%%%%%%%%%%%%%%%%%%%%) x0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) a0123456789876543210 x0123456789876543210) where + instance SuppressUnusedWarnings (<<<%%%%%%%%%%%%%%%%%%%%@#@$) where suppressUnusedWarnings - = snd (((,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$$###)) ()) - data (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 (a0123456789876543210 :: Nat) :: (~>) Nat Nat + = snd (((,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$###)) ()) + data (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210 where - (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$$###) :: forall x0123456789876543210 - a0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$$) x0123456789876543210 a0123456789876543210 arg) => - (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210 a0123456789876543210 - type instance Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) a0123456789876543210 x0123456789876543210) a0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$$) a0123456789876543210 x0123456789876543210 a0123456789876543210 + (:<<<%%%%%%%%%%%%%%%%%%%%@#@$###) :: forall x0123456789876543210 + arg. SameKind (Apply (<<<%%%%%%%%%%%%%%%%%%%%@#@$) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) arg) => + (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210 + type instance Apply (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 instance SuppressUnusedWarnings ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210) where suppressUnusedWarnings = snd (((,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$###)) ()) @@ -272,20 +268,22 @@ Singletons/LetStatements.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 arg) => (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 a0123456789876543210 type instance Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210) a0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (<<<%%%%%%%%%%%%%%%%%%%%@#@$) where + instance SuppressUnusedWarnings ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210) where suppressUnusedWarnings - = snd (((,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$###)) ()) - data (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210 + = snd (((,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$$###)) ()) + data (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 (a0123456789876543210 :: Nat) :: (~>) Nat Nat where - (:<<<%%%%%%%%%%%%%%%%%%%%@#@$###) :: forall x0123456789876543210 - arg. SameKind (Apply (<<<%%%%%%%%%%%%%%%%%%%%@#@$) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) arg) => - (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210 - type instance Apply (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 + (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$$###) :: forall x0123456789876543210 + a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$$) x0123456789876543210 a0123456789876543210 arg) => + (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210 a0123456789876543210 + type instance Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210) a0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$$) x0123456789876543210 a0123456789876543210 a0123456789876543210 + type (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$$) x0123456789876543210 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) = + (<<<%%%%%%%%%%%%%%%%%%%%) x0123456789876543210 a0123456789876543210 a0123456789876543210 type family (<<<%%%%%%%%%%%%%%%%%%%%) x (a :: Nat) (a :: Nat) :: Nat where (<<<%%%%%%%%%%%%%%%%%%%%) x 'Zero m = m (<<<%%%%%%%%%%%%%%%%%%%%) x ('Succ n) m = Apply SuccSym0 (Apply (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x) n) x) - type Let0123456789876543210ZSym1 x0123456789876543210 = - Let0123456789876543210Z x0123456789876543210 instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where suppressUnusedWarnings = snd (((,) Let0123456789876543210ZSym0KindInference) ()) @@ -295,19 +293,17 @@ Singletons/LetStatements.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) => Let0123456789876543210ZSym0 x0123456789876543210 type instance Apply Let0123456789876543210ZSym0 x0123456789876543210 = Let0123456789876543210ZSym1 x0123456789876543210 - type (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$$) x0123456789876543210 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) = - (<<<%%%%%%%%%%%%%%%%%%%%) x0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) a0123456789876543210 x0123456789876543210) where + type Let0123456789876543210ZSym1 x0123456789876543210 = + Let0123456789876543210Z x0123456789876543210 + instance SuppressUnusedWarnings (<<<%%%%%%%%%%%%%%%%%%%%@#@$) where suppressUnusedWarnings - = snd (((,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$$###)) ()) - data (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 (a0123456789876543210 :: Nat) :: (~>) Nat Nat + = snd (((,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$###)) ()) + data (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210 where - (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$$###) :: forall x0123456789876543210 - a0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$$) x0123456789876543210 a0123456789876543210 arg) => - (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210 a0123456789876543210 - type instance Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) a0123456789876543210 x0123456789876543210) a0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$$) a0123456789876543210 x0123456789876543210 a0123456789876543210 + (:<<<%%%%%%%%%%%%%%%%%%%%@#@$###) :: forall x0123456789876543210 + arg. SameKind (Apply (<<<%%%%%%%%%%%%%%%%%%%%@#@$) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) arg) => + (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210 + type instance Apply (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 instance SuppressUnusedWarnings ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210) where suppressUnusedWarnings = snd (((,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$###)) ()) @@ -318,23 +314,7 @@ Singletons/LetStatements.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 arg) => (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 a0123456789876543210 type instance Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210) a0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (<<<%%%%%%%%%%%%%%%%%%%%@#@$) where - suppressUnusedWarnings - = snd (((,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$###)) ()) - data (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210 - where - (:<<<%%%%%%%%%%%%%%%%%%%%@#@$###) :: forall x0123456789876543210 - arg. SameKind (Apply (<<<%%%%%%%%%%%%%%%%%%%%@#@$) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) arg) => - (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210 - type instance Apply (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 - type family Let0123456789876543210Z x :: Nat where - Let0123456789876543210Z x = x - type family (<<<%%%%%%%%%%%%%%%%%%%%) x (a :: Nat) (a :: Nat) :: Nat where - (<<<%%%%%%%%%%%%%%%%%%%%) x 'Zero m = m - (<<<%%%%%%%%%%%%%%%%%%%%) x ('Succ n) m = Apply SuccSym0 (Apply (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x) n) m) - type (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$$) x0123456789876543210 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) = - (<<<%%%%%%%%%%%%%%%%%%%%) x0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) a0123456789876543210 x0123456789876543210) where + instance SuppressUnusedWarnings ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210) where suppressUnusedWarnings = snd (((,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$$###)) ()) data (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 (a0123456789876543210 :: Nat) :: (~>) Nat Nat @@ -344,7 +324,23 @@ Singletons/LetStatements.hs:(0,0)-(0,0): Splicing declarations a0123456789876543210 arg. SameKind (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$$) x0123456789876543210 a0123456789876543210 arg) => (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210 a0123456789876543210 - type instance Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) a0123456789876543210 x0123456789876543210) a0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$$) a0123456789876543210 x0123456789876543210 a0123456789876543210 + type instance Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210) a0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$$) x0123456789876543210 a0123456789876543210 a0123456789876543210 + type (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$$) x0123456789876543210 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) = + (<<<%%%%%%%%%%%%%%%%%%%%) x0123456789876543210 a0123456789876543210 a0123456789876543210 + type family Let0123456789876543210Z x :: Nat where + Let0123456789876543210Z x = x + type family (<<<%%%%%%%%%%%%%%%%%%%%) x (a :: Nat) (a :: Nat) :: Nat where + (<<<%%%%%%%%%%%%%%%%%%%%) x 'Zero m = m + (<<<%%%%%%%%%%%%%%%%%%%%) x ('Succ n) m = Apply SuccSym0 (Apply (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x) n) m) + instance SuppressUnusedWarnings (<<<%%%%%%%%%%%%%%%%%%%%@#@$) where + suppressUnusedWarnings + = snd (((,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$###)) ()) + data (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210 + where + (:<<<%%%%%%%%%%%%%%%%%%%%@#@$###) :: forall x0123456789876543210 + arg. SameKind (Apply (<<<%%%%%%%%%%%%%%%%%%%%@#@$) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) arg) => + (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210 + type instance Apply (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 instance SuppressUnusedWarnings ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210) where suppressUnusedWarnings = snd (((,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$###)) ()) @@ -355,33 +351,33 @@ Singletons/LetStatements.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 arg) => (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 a0123456789876543210 type instance Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210) a0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (<<<%%%%%%%%%%%%%%%%%%%%@#@$) where + instance SuppressUnusedWarnings ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210) where suppressUnusedWarnings - = snd (((,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$###)) ()) - data (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210 + = snd (((,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$$###)) ()) + data (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 (a0123456789876543210 :: Nat) :: (~>) Nat Nat where - (:<<<%%%%%%%%%%%%%%%%%%%%@#@$###) :: forall x0123456789876543210 - arg. SameKind (Apply (<<<%%%%%%%%%%%%%%%%%%%%@#@$) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) arg) => - (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210 - type instance Apply (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 + (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$$###) :: forall x0123456789876543210 + a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$$) x0123456789876543210 a0123456789876543210 arg) => + (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210 a0123456789876543210 + type instance Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210) a0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$$) x0123456789876543210 a0123456789876543210 a0123456789876543210 + type (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$$) x0123456789876543210 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) = + (<<<%%%%%%%%%%%%%%%%%%%%) x0123456789876543210 a0123456789876543210 a0123456789876543210 type family (<<<%%%%%%%%%%%%%%%%%%%%) x (a :: Nat) (a :: Nat) :: Nat where (<<<%%%%%%%%%%%%%%%%%%%%) x 'Zero m = m (<<<%%%%%%%%%%%%%%%%%%%%) x ('Succ n) m = Apply SuccSym0 (Apply (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x) n) m) type family Lambda_0123456789876543210 a_0123456789876543210 x t where Lambda_0123456789876543210 a_0123456789876543210 x x = x - type Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 x0123456789876543210 t0123456789876543210 = - Lambda_0123456789876543210 a_01234567898765432100123456789876543210 x0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 x0123456789876543210 a_01234567898765432100123456789876543210) where + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) - data Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 x0123456789876543210 t0123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 a_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym2KindInference :: forall a_01234567898765432100123456789876543210 - x0123456789876543210 - t0123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 x0123456789876543210) arg) (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 x0123456789876543210 arg) => - Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 x0123456789876543210 t0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 a_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym3 x0123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + 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 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) @@ -392,17 +388,28 @@ Singletons/LetStatements.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210 x0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210) x0123456789876543210 = Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 x0123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 x0123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) - data Lambda_0123456789876543210Sym0 a_01234567898765432100123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 x0123456789876543210 t0123456789876543210 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 Let0123456789876543210ZSym2 x0123456789876543210 (a0123456789876543210 :: Nat) = - Let0123456789876543210Z x0123456789876543210 a0123456789876543210 + Lambda_0123456789876543210Sym2KindInference :: forall a_01234567898765432100123456789876543210 + x0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 x0123456789876543210) arg) (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 x0123456789876543210 arg) => + Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 x0123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 x0123456789876543210 t0123456789876543210 + type Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 x0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 a_01234567898765432100123456789876543210 x0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where + suppressUnusedWarnings + = snd (((,) Let0123456789876543210ZSym0KindInference) ()) + data Let0123456789876543210ZSym0 x0123456789876543210 + where + Let0123456789876543210ZSym0KindInference :: forall x0123456789876543210 + arg. SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) => + Let0123456789876543210ZSym0 x0123456789876543210 + type instance Apply Let0123456789876543210ZSym0 x0123456789876543210 = Let0123456789876543210ZSym1 x0123456789876543210 instance SuppressUnusedWarnings (Let0123456789876543210ZSym1 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Let0123456789876543210ZSym1KindInference) ()) @@ -413,21 +420,21 @@ Singletons/LetStatements.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Let0123456789876543210ZSym1 x0123456789876543210) arg) (Let0123456789876543210ZSym2 x0123456789876543210 arg) => Let0123456789876543210ZSym1 x0123456789876543210 a0123456789876543210 type instance Apply (Let0123456789876543210ZSym1 x0123456789876543210) a0123456789876543210 = Let0123456789876543210ZSym2 x0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where - suppressUnusedWarnings - = snd (((,) Let0123456789876543210ZSym0KindInference) ()) - data Let0123456789876543210ZSym0 x0123456789876543210 - where - Let0123456789876543210ZSym0KindInference :: forall x0123456789876543210 - arg. SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) => - Let0123456789876543210ZSym0 x0123456789876543210 - type instance Apply Let0123456789876543210ZSym0 x0123456789876543210 = Let0123456789876543210ZSym1 x0123456789876543210 + type Let0123456789876543210ZSym2 x0123456789876543210 (a0123456789876543210 :: Nat) = + Let0123456789876543210Z x0123456789876543210 a0123456789876543210 type family Let0123456789876543210Z x (a :: Nat) :: Nat where Let0123456789876543210Z x a_0123456789876543210 = Apply (Apply (Apply Lambda_0123456789876543210Sym0 a_0123456789876543210) x) a_0123456789876543210 type family Lambda_0123456789876543210 x t where Lambda_0123456789876543210 x x = x - type Lambda_0123456789876543210Sym2 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 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) @@ -438,17 +445,8 @@ Singletons/LetStatements.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) => Lambda_0123456789876543210Sym1 x0123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym2 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 Let0123456789876543210ZSym1 x0123456789876543210 = - Let0123456789876543210Z x0123456789876543210 + type Lambda_0123456789876543210Sym2 x0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 x0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where suppressUnusedWarnings = snd (((,) Let0123456789876543210ZSym0KindInference) ()) @@ -458,10 +456,10 @@ Singletons/LetStatements.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) => Let0123456789876543210ZSym0 x0123456789876543210 type instance Apply Let0123456789876543210ZSym0 x0123456789876543210 = Let0123456789876543210ZSym1 x0123456789876543210 + type Let0123456789876543210ZSym1 x0123456789876543210 = + Let0123456789876543210Z x0123456789876543210 type family Let0123456789876543210Z x :: Nat where Let0123456789876543210Z x = Apply (Apply Lambda_0123456789876543210Sym0 x) ZeroSym0 - type Let0123456789876543210XSym1 x0123456789876543210 = - Let0123456789876543210X x0123456789876543210 instance SuppressUnusedWarnings Let0123456789876543210XSym0 where suppressUnusedWarnings = snd (((,) Let0123456789876543210XSym0KindInference) ()) @@ -471,10 +469,19 @@ Singletons/LetStatements.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Let0123456789876543210XSym0 arg) (Let0123456789876543210XSym1 arg) => Let0123456789876543210XSym0 x0123456789876543210 type instance Apply Let0123456789876543210XSym0 x0123456789876543210 = Let0123456789876543210XSym1 x0123456789876543210 + type Let0123456789876543210XSym1 x0123456789876543210 = + Let0123456789876543210X x0123456789876543210 type family Let0123456789876543210X x :: Nat where Let0123456789876543210X x = ZeroSym0 - type Let0123456789876543210FSym2 x0123456789876543210 (a0123456789876543210 :: Nat) = - Let0123456789876543210F x0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Let0123456789876543210FSym0 where + suppressUnusedWarnings + = snd (((,) Let0123456789876543210FSym0KindInference) ()) + data Let0123456789876543210FSym0 x0123456789876543210 + where + Let0123456789876543210FSym0KindInference :: forall x0123456789876543210 + arg. SameKind (Apply Let0123456789876543210FSym0 arg) (Let0123456789876543210FSym1 arg) => + Let0123456789876543210FSym0 x0123456789876543210 + type instance Apply Let0123456789876543210FSym0 x0123456789876543210 = Let0123456789876543210FSym1 x0123456789876543210 instance SuppressUnusedWarnings (Let0123456789876543210FSym1 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Let0123456789876543210FSym1KindInference) ()) @@ -485,19 +492,10 @@ Singletons/LetStatements.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Let0123456789876543210FSym1 x0123456789876543210) arg) (Let0123456789876543210FSym2 x0123456789876543210 arg) => Let0123456789876543210FSym1 x0123456789876543210 a0123456789876543210 type instance Apply (Let0123456789876543210FSym1 x0123456789876543210) a0123456789876543210 = Let0123456789876543210FSym2 x0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings Let0123456789876543210FSym0 where - suppressUnusedWarnings - = snd (((,) Let0123456789876543210FSym0KindInference) ()) - data Let0123456789876543210FSym0 x0123456789876543210 - where - Let0123456789876543210FSym0KindInference :: forall x0123456789876543210 - arg. SameKind (Apply Let0123456789876543210FSym0 arg) (Let0123456789876543210FSym1 arg) => - Let0123456789876543210FSym0 x0123456789876543210 - type instance Apply Let0123456789876543210FSym0 x0123456789876543210 = Let0123456789876543210FSym1 x0123456789876543210 + type Let0123456789876543210FSym2 x0123456789876543210 (a0123456789876543210 :: Nat) = + Let0123456789876543210F x0123456789876543210 a0123456789876543210 type family Let0123456789876543210F x (a :: Nat) :: Nat where Let0123456789876543210F x y = Apply SuccSym0 y - type Let0123456789876543210ZSym1 x0123456789876543210 = - Let0123456789876543210Z x0123456789876543210 instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where suppressUnusedWarnings = snd (((,) Let0123456789876543210ZSym0KindInference) ()) @@ -507,10 +505,19 @@ Singletons/LetStatements.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) => Let0123456789876543210ZSym0 x0123456789876543210 type instance Apply Let0123456789876543210ZSym0 x0123456789876543210 = Let0123456789876543210ZSym1 x0123456789876543210 + type Let0123456789876543210ZSym1 x0123456789876543210 = + Let0123456789876543210Z x0123456789876543210 type family Let0123456789876543210Z x :: Nat where Let0123456789876543210Z x = Apply (Let0123456789876543210FSym1 x) x - type Let0123456789876543210ZSym2 y0123456789876543210 x0123456789876543210 = - Let0123456789876543210Z y0123456789876543210 x0123456789876543210 + instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where + suppressUnusedWarnings + = snd (((,) Let0123456789876543210ZSym0KindInference) ()) + data Let0123456789876543210ZSym0 y0123456789876543210 + where + Let0123456789876543210ZSym0KindInference :: forall y0123456789876543210 + arg. SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) => + Let0123456789876543210ZSym0 y0123456789876543210 + type instance Apply Let0123456789876543210ZSym0 y0123456789876543210 = Let0123456789876543210ZSym1 y0123456789876543210 instance SuppressUnusedWarnings (Let0123456789876543210ZSym1 y0123456789876543210) where suppressUnusedWarnings = snd (((,) Let0123456789876543210ZSym1KindInference) ()) @@ -521,19 +528,19 @@ Singletons/LetStatements.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Let0123456789876543210ZSym1 y0123456789876543210) arg) (Let0123456789876543210ZSym2 y0123456789876543210 arg) => Let0123456789876543210ZSym1 y0123456789876543210 x0123456789876543210 type instance Apply (Let0123456789876543210ZSym1 y0123456789876543210) x0123456789876543210 = Let0123456789876543210ZSym2 y0123456789876543210 x0123456789876543210 - instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where - suppressUnusedWarnings - = snd (((,) Let0123456789876543210ZSym0KindInference) ()) - data Let0123456789876543210ZSym0 y0123456789876543210 - where - Let0123456789876543210ZSym0KindInference :: forall y0123456789876543210 - arg. SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) => - Let0123456789876543210ZSym0 y0123456789876543210 - type instance Apply Let0123456789876543210ZSym0 y0123456789876543210 = Let0123456789876543210ZSym1 y0123456789876543210 + type Let0123456789876543210ZSym2 y0123456789876543210 x0123456789876543210 = + Let0123456789876543210Z y0123456789876543210 x0123456789876543210 type family Let0123456789876543210Z y x :: Nat where Let0123456789876543210Z y x = Apply SuccSym0 y - type Let0123456789876543210FSym2 x0123456789876543210 (a0123456789876543210 :: Nat) = - Let0123456789876543210F x0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Let0123456789876543210FSym0 where + suppressUnusedWarnings + = snd (((,) Let0123456789876543210FSym0KindInference) ()) + data Let0123456789876543210FSym0 x0123456789876543210 + where + Let0123456789876543210FSym0KindInference :: forall x0123456789876543210 + arg. SameKind (Apply Let0123456789876543210FSym0 arg) (Let0123456789876543210FSym1 arg) => + Let0123456789876543210FSym0 x0123456789876543210 + type instance Apply Let0123456789876543210FSym0 x0123456789876543210 = Let0123456789876543210FSym1 x0123456789876543210 instance SuppressUnusedWarnings (Let0123456789876543210FSym1 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Let0123456789876543210FSym1KindInference) ()) @@ -544,6 +551,10 @@ Singletons/LetStatements.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Let0123456789876543210FSym1 x0123456789876543210) arg) (Let0123456789876543210FSym2 x0123456789876543210 arg) => Let0123456789876543210FSym1 x0123456789876543210 a0123456789876543210 type instance Apply (Let0123456789876543210FSym1 x0123456789876543210) a0123456789876543210 = Let0123456789876543210FSym2 x0123456789876543210 a0123456789876543210 + type Let0123456789876543210FSym2 x0123456789876543210 (a0123456789876543210 :: Nat) = + Let0123456789876543210F x0123456789876543210 a0123456789876543210 + type family Let0123456789876543210F x (a :: Nat) :: Nat where + Let0123456789876543210F x y = Apply SuccSym0 (Let0123456789876543210ZSym2 y x) instance SuppressUnusedWarnings Let0123456789876543210FSym0 where suppressUnusedWarnings = snd (((,) Let0123456789876543210FSym0KindInference) ()) @@ -553,10 +564,6 @@ Singletons/LetStatements.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Let0123456789876543210FSym0 arg) (Let0123456789876543210FSym1 arg) => Let0123456789876543210FSym0 x0123456789876543210 type instance Apply Let0123456789876543210FSym0 x0123456789876543210 = Let0123456789876543210FSym1 x0123456789876543210 - type family Let0123456789876543210F x (a :: Nat) :: Nat where - Let0123456789876543210F x y = Apply SuccSym0 (Let0123456789876543210ZSym2 y x) - type Let0123456789876543210FSym2 x0123456789876543210 (a0123456789876543210 :: Nat) = - Let0123456789876543210F x0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Let0123456789876543210FSym1 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Let0123456789876543210FSym1KindInference) ()) @@ -567,19 +574,10 @@ Singletons/LetStatements.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Let0123456789876543210FSym1 x0123456789876543210) arg) (Let0123456789876543210FSym2 x0123456789876543210 arg) => Let0123456789876543210FSym1 x0123456789876543210 a0123456789876543210 type instance Apply (Let0123456789876543210FSym1 x0123456789876543210) a0123456789876543210 = Let0123456789876543210FSym2 x0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings Let0123456789876543210FSym0 where - suppressUnusedWarnings - = snd (((,) Let0123456789876543210FSym0KindInference) ()) - data Let0123456789876543210FSym0 x0123456789876543210 - where - Let0123456789876543210FSym0KindInference :: forall x0123456789876543210 - arg. SameKind (Apply Let0123456789876543210FSym0 arg) (Let0123456789876543210FSym1 arg) => - Let0123456789876543210FSym0 x0123456789876543210 - type instance Apply Let0123456789876543210FSym0 x0123456789876543210 = Let0123456789876543210FSym1 x0123456789876543210 + type Let0123456789876543210FSym2 x0123456789876543210 (a0123456789876543210 :: Nat) = + Let0123456789876543210F x0123456789876543210 a0123456789876543210 type family Let0123456789876543210F x (a :: Nat) :: Nat where Let0123456789876543210F x y = Apply SuccSym0 y - type Let0123456789876543210YSym1 x0123456789876543210 = - Let0123456789876543210Y x0123456789876543210 instance SuppressUnusedWarnings Let0123456789876543210YSym0 where suppressUnusedWarnings = snd (((,) Let0123456789876543210YSym0KindInference) ()) @@ -589,6 +587,8 @@ Singletons/LetStatements.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Let0123456789876543210YSym0 arg) (Let0123456789876543210YSym1 arg) => Let0123456789876543210YSym0 x0123456789876543210 type instance Apply Let0123456789876543210YSym0 x0123456789876543210 = Let0123456789876543210YSym1 x0123456789876543210 + type Let0123456789876543210YSym1 x0123456789876543210 = + Let0123456789876543210Y x0123456789876543210 type family Let0123456789876543210Y x :: Nat where Let0123456789876543210Y x = Apply SuccSym0 x type Let0123456789876543210ZSym0 = Let0123456789876543210Z @@ -597,8 +597,6 @@ Singletons/LetStatements.hs:(0,0)-(0,0): Splicing declarations Let0123456789876543210Z = Apply SuccSym0 Let0123456789876543210YSym0 type family Let0123456789876543210Y where Let0123456789876543210Y = Apply SuccSym0 ZeroSym0 - type Let0123456789876543210YSym1 x0123456789876543210 = - Let0123456789876543210Y x0123456789876543210 instance SuppressUnusedWarnings Let0123456789876543210YSym0 where suppressUnusedWarnings = snd (((,) Let0123456789876543210YSym0KindInference) ()) @@ -608,10 +606,10 @@ Singletons/LetStatements.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Let0123456789876543210YSym0 arg) (Let0123456789876543210YSym1 arg) => Let0123456789876543210YSym0 x0123456789876543210 type instance Apply Let0123456789876543210YSym0 x0123456789876543210 = Let0123456789876543210YSym1 x0123456789876543210 + type Let0123456789876543210YSym1 x0123456789876543210 = + Let0123456789876543210Y x0123456789876543210 type family Let0123456789876543210Y x :: Nat where Let0123456789876543210Y x = Apply SuccSym0 ZeroSym0 - type Foo14Sym1 (a0123456789876543210 :: Nat) = - Foo14 a0123456789876543210 instance SuppressUnusedWarnings Foo14Sym0 where suppressUnusedWarnings = snd (((,) Foo14Sym0KindInference) ()) data Foo14Sym0 :: (~>) Nat (Nat, Nat) @@ -620,8 +618,8 @@ Singletons/LetStatements.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Foo14Sym0 arg) (Foo14Sym1 arg) => Foo14Sym0 a0123456789876543210 type instance Apply Foo14Sym0 a0123456789876543210 = Foo14Sym1 a0123456789876543210 - type Foo13_Sym1 (a0123456789876543210 :: a0123456789876543210) = - Foo13_ a0123456789876543210 + type Foo14Sym1 (a0123456789876543210 :: Nat) = + Foo14 a0123456789876543210 instance SuppressUnusedWarnings Foo13_Sym0 where suppressUnusedWarnings = snd (((,) Foo13_Sym0KindInference) ()) data Foo13_Sym0 :: forall a0123456789876543210. @@ -631,8 +629,8 @@ Singletons/LetStatements.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Foo13_Sym0 arg) (Foo13_Sym1 arg) => Foo13_Sym0 a0123456789876543210 type instance Apply Foo13_Sym0 a0123456789876543210 = Foo13_Sym1 a0123456789876543210 - type Foo13Sym1 (a0123456789876543210 :: a0123456789876543210) = - Foo13 a0123456789876543210 + type Foo13_Sym1 (a0123456789876543210 :: a0123456789876543210) = + Foo13_ a0123456789876543210 instance SuppressUnusedWarnings Foo13Sym0 where suppressUnusedWarnings = snd (((,) Foo13Sym0KindInference) ()) data Foo13Sym0 :: forall a0123456789876543210. @@ -642,8 +640,8 @@ Singletons/LetStatements.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Foo13Sym0 arg) (Foo13Sym1 arg) => Foo13Sym0 a0123456789876543210 type instance Apply Foo13Sym0 a0123456789876543210 = Foo13Sym1 a0123456789876543210 - type Foo12Sym1 (a0123456789876543210 :: Nat) = - Foo12 a0123456789876543210 + type Foo13Sym1 (a0123456789876543210 :: a0123456789876543210) = + Foo13 a0123456789876543210 instance SuppressUnusedWarnings Foo12Sym0 where suppressUnusedWarnings = snd (((,) Foo12Sym0KindInference) ()) data Foo12Sym0 :: (~>) Nat Nat @@ -652,8 +650,8 @@ Singletons/LetStatements.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Foo12Sym0 arg) (Foo12Sym1 arg) => Foo12Sym0 a0123456789876543210 type instance Apply Foo12Sym0 a0123456789876543210 = Foo12Sym1 a0123456789876543210 - type Foo11Sym1 (a0123456789876543210 :: Nat) = - Foo11 a0123456789876543210 + type Foo12Sym1 (a0123456789876543210 :: Nat) = + Foo12 a0123456789876543210 instance SuppressUnusedWarnings Foo11Sym0 where suppressUnusedWarnings = snd (((,) Foo11Sym0KindInference) ()) data Foo11Sym0 :: (~>) Nat Nat @@ -662,8 +660,8 @@ Singletons/LetStatements.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Foo11Sym0 arg) (Foo11Sym1 arg) => Foo11Sym0 a0123456789876543210 type instance Apply Foo11Sym0 a0123456789876543210 = Foo11Sym1 a0123456789876543210 - type Foo10Sym1 (a0123456789876543210 :: Nat) = - Foo10 a0123456789876543210 + type Foo11Sym1 (a0123456789876543210 :: Nat) = + Foo11 a0123456789876543210 instance SuppressUnusedWarnings Foo10Sym0 where suppressUnusedWarnings = snd (((,) Foo10Sym0KindInference) ()) data Foo10Sym0 :: (~>) Nat Nat @@ -672,8 +670,8 @@ Singletons/LetStatements.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Foo10Sym0 arg) (Foo10Sym1 arg) => Foo10Sym0 a0123456789876543210 type instance Apply Foo10Sym0 a0123456789876543210 = Foo10Sym1 a0123456789876543210 - type Foo9Sym1 (a0123456789876543210 :: Nat) = - Foo9 a0123456789876543210 + type Foo10Sym1 (a0123456789876543210 :: Nat) = + Foo10 a0123456789876543210 instance SuppressUnusedWarnings Foo9Sym0 where suppressUnusedWarnings = snd (((,) Foo9Sym0KindInference) ()) data Foo9Sym0 :: (~>) Nat Nat @@ -682,8 +680,8 @@ Singletons/LetStatements.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Foo9Sym0 arg) (Foo9Sym1 arg) => Foo9Sym0 a0123456789876543210 type instance Apply Foo9Sym0 a0123456789876543210 = Foo9Sym1 a0123456789876543210 - type Foo8Sym1 (a0123456789876543210 :: Nat) = - Foo8 a0123456789876543210 + type Foo9Sym1 (a0123456789876543210 :: Nat) = + Foo9 a0123456789876543210 instance SuppressUnusedWarnings Foo8Sym0 where suppressUnusedWarnings = snd (((,) Foo8Sym0KindInference) ()) data Foo8Sym0 :: (~>) Nat Nat @@ -692,8 +690,8 @@ Singletons/LetStatements.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Foo8Sym0 arg) (Foo8Sym1 arg) => Foo8Sym0 a0123456789876543210 type instance Apply Foo8Sym0 a0123456789876543210 = Foo8Sym1 a0123456789876543210 - type Foo7Sym1 (a0123456789876543210 :: Nat) = - Foo7 a0123456789876543210 + type Foo8Sym1 (a0123456789876543210 :: Nat) = + Foo8 a0123456789876543210 instance SuppressUnusedWarnings Foo7Sym0 where suppressUnusedWarnings = snd (((,) Foo7Sym0KindInference) ()) data Foo7Sym0 :: (~>) Nat Nat @@ -702,8 +700,8 @@ Singletons/LetStatements.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Foo7Sym0 arg) (Foo7Sym1 arg) => Foo7Sym0 a0123456789876543210 type instance Apply Foo7Sym0 a0123456789876543210 = Foo7Sym1 a0123456789876543210 - type Foo6Sym1 (a0123456789876543210 :: Nat) = - Foo6 a0123456789876543210 + type Foo7Sym1 (a0123456789876543210 :: Nat) = + Foo7 a0123456789876543210 instance SuppressUnusedWarnings Foo6Sym0 where suppressUnusedWarnings = snd (((,) Foo6Sym0KindInference) ()) data Foo6Sym0 :: (~>) Nat Nat @@ -712,8 +710,8 @@ Singletons/LetStatements.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Foo6Sym0 arg) (Foo6Sym1 arg) => Foo6Sym0 a0123456789876543210 type instance Apply Foo6Sym0 a0123456789876543210 = Foo6Sym1 a0123456789876543210 - type Foo5Sym1 (a0123456789876543210 :: Nat) = - Foo5 a0123456789876543210 + type Foo6Sym1 (a0123456789876543210 :: Nat) = + Foo6 a0123456789876543210 instance SuppressUnusedWarnings Foo5Sym0 where suppressUnusedWarnings = snd (((,) Foo5Sym0KindInference) ()) data Foo5Sym0 :: (~>) Nat Nat @@ -722,8 +720,8 @@ Singletons/LetStatements.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Foo5Sym0 arg) (Foo5Sym1 arg) => Foo5Sym0 a0123456789876543210 type instance Apply Foo5Sym0 a0123456789876543210 = Foo5Sym1 a0123456789876543210 - type Foo4Sym1 (a0123456789876543210 :: Nat) = - Foo4 a0123456789876543210 + type Foo5Sym1 (a0123456789876543210 :: Nat) = + Foo5 a0123456789876543210 instance SuppressUnusedWarnings Foo4Sym0 where suppressUnusedWarnings = snd (((,) Foo4Sym0KindInference) ()) data Foo4Sym0 :: (~>) Nat Nat @@ -732,8 +730,8 @@ Singletons/LetStatements.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Foo4Sym0 arg) (Foo4Sym1 arg) => Foo4Sym0 a0123456789876543210 type instance Apply Foo4Sym0 a0123456789876543210 = Foo4Sym1 a0123456789876543210 - type Foo3Sym1 (a0123456789876543210 :: Nat) = - Foo3 a0123456789876543210 + type Foo4Sym1 (a0123456789876543210 :: Nat) = + Foo4 a0123456789876543210 instance SuppressUnusedWarnings Foo3Sym0 where suppressUnusedWarnings = snd (((,) Foo3Sym0KindInference) ()) data Foo3Sym0 :: (~>) Nat Nat @@ -742,9 +740,9 @@ Singletons/LetStatements.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Foo3Sym0 arg) (Foo3Sym1 arg) => Foo3Sym0 a0123456789876543210 type instance Apply Foo3Sym0 a0123456789876543210 = Foo3Sym1 a0123456789876543210 + type Foo3Sym1 (a0123456789876543210 :: Nat) = + Foo3 a0123456789876543210 type Foo2Sym0 = Foo2 - type Foo1Sym1 (a0123456789876543210 :: Nat) = - Foo1 a0123456789876543210 instance SuppressUnusedWarnings Foo1Sym0 where suppressUnusedWarnings = snd (((,) Foo1Sym0KindInference) ()) data Foo1Sym0 :: (~>) Nat Nat @@ -753,6 +751,8 @@ Singletons/LetStatements.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Foo1Sym0 arg) (Foo1Sym1 arg) => Foo1Sym0 a0123456789876543210 type instance Apply Foo1Sym0 a0123456789876543210 = Foo1Sym1 a0123456789876543210 + type Foo1Sym1 (a0123456789876543210 :: Nat) = + Foo1 a0123456789876543210 type family Foo14 (a :: Nat) :: (Nat, Nat) where Foo14 x = Apply (Apply Tuple2Sym0 (Let0123456789876543210ZSym1 x)) (Let0123456789876543210YSym1 x) type family Foo13_ (a :: a) :: a where diff --git a/tests/compile-and-dump/Singletons/Maybe.golden b/tests/compile-and-dump/Singletons/Maybe.golden index cc36213c..6058551b 100644 --- a/tests/compile-and-dump/Singletons/Maybe.golden +++ b/tests/compile-and-dump/Singletons/Maybe.golden @@ -8,8 +8,6 @@ Singletons/Maybe.hs:(0,0)-(0,0): Splicing declarations = Nothing | Just a deriving (Eq, Show) type NothingSym0 = Nothing - type JustSym1 (t0123456789876543210 :: a0123456789876543210) = - Just t0123456789876543210 instance SuppressUnusedWarnings JustSym0 where suppressUnusedWarnings = snd (((,) JustSym0KindInference) ()) data JustSym0 :: forall a0123456789876543210. @@ -19,22 +17,21 @@ Singletons/Maybe.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply JustSym0 arg) (JustSym1 arg) => JustSym0 t0123456789876543210 type instance Apply JustSym0 t0123456789876543210 = JustSym1 t0123456789876543210 + type JustSym1 (t0123456789876543210 :: a0123456789876543210) = + Just t0123456789876543210 type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Maybe a) (a :: GHC.Types.Symbol) :: GHC.Types.Symbol where ShowsPrec_0123456789876543210 _ Nothing a_0123456789876543210 = Apply (Apply ShowStringSym0 "Nothing") a_0123456789876543210 ShowsPrec_0123456789876543210 p_0123456789876543210 (Just arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (Data.Singletons.Prelude.Num.FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "Just ")) (Apply (Apply ShowsPrecSym0 (Data.Singletons.Prelude.Num.FromInteger 11)) arg_0123456789876543210))) a_0123456789876543210 - type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Maybe a0123456789876543210) (a0123456789876543210 :: GHC.Types.Symbol) = - ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where suppressUnusedWarnings - = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) - data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Maybe a0123456789876543210) :: (~>) GHC.Types.Symbol GHC.Types.Symbol + = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) + data ShowsPrec_0123456789876543210Sym0 :: forall a0123456789876543210. + (~>) GHC.Types.Nat ((~>) (Maybe a0123456789876543210) ((~>) GHC.Types.Symbol GHC.Types.Symbol)) where - ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 - a0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => - ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 - type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 + ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => + ShowsPrec_0123456789876543210Sym0 a0123456789876543210 + type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ()) @@ -46,16 +43,19 @@ Singletons/Maybe.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) => ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where + instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where suppressUnusedWarnings - = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) - data ShowsPrec_0123456789876543210Sym0 :: forall a0123456789876543210. - (~>) GHC.Types.Nat ((~>) (Maybe a0123456789876543210) ((~>) GHC.Types.Symbol GHC.Types.Symbol)) + = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) + data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Maybe a0123456789876543210) :: (~>) GHC.Types.Symbol GHC.Types.Symbol where - ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => - ShowsPrec_0123456789876543210Sym0 a0123456789876543210 - type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 + ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 + a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => + ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Maybe a0123456789876543210) (a0123456789876543210 :: GHC.Types.Symbol) = + ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance PShow (Maybe a) where type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a type family Equals_0123456789876543210 (a :: Maybe a) (b :: Maybe a) :: Bool where diff --git a/tests/compile-and-dump/Singletons/Nat.golden b/tests/compile-and-dump/Singletons/Nat.golden index 22b8588d..429b0a88 100644 --- a/tests/compile-and-dump/Singletons/Nat.golden +++ b/tests/compile-and-dump/Singletons/Nat.golden @@ -25,8 +25,6 @@ Singletons/Nat.hs:(0,0)-(0,0): Splicing declarations pred Zero = Zero pred (Succ n) = n type ZeroSym0 = Zero - type SuccSym1 (t0123456789876543210 :: Nat) = - Succ t0123456789876543210 instance SuppressUnusedWarnings SuccSym0 where suppressUnusedWarnings = snd (((,) SuccSym0KindInference) ()) data SuccSym0 :: (~>) Nat Nat @@ -35,8 +33,8 @@ Singletons/Nat.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply SuccSym0 arg) (SuccSym1 arg) => SuccSym0 t0123456789876543210 type instance Apply SuccSym0 t0123456789876543210 = SuccSym1 t0123456789876543210 - type PredSym1 (a0123456789876543210 :: Nat) = - Pred a0123456789876543210 + type SuccSym1 (t0123456789876543210 :: Nat) = + Succ t0123456789876543210 instance SuppressUnusedWarnings PredSym0 where suppressUnusedWarnings = snd (((,) PredSym0KindInference) ()) data PredSym0 :: (~>) Nat Nat @@ -45,8 +43,16 @@ Singletons/Nat.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply PredSym0 arg) (PredSym1 arg) => PredSym0 a0123456789876543210 type instance Apply PredSym0 a0123456789876543210 = PredSym1 a0123456789876543210 - type PlusSym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) = - Plus a0123456789876543210 a0123456789876543210 + type PredSym1 (a0123456789876543210 :: Nat) = + Pred a0123456789876543210 + instance SuppressUnusedWarnings PlusSym0 where + suppressUnusedWarnings = snd (((,) PlusSym0KindInference) ()) + data PlusSym0 :: (~>) Nat ((~>) Nat Nat) + where + PlusSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply PlusSym0 arg) (PlusSym1 arg) => + PlusSym0 a0123456789876543210 + type instance Apply PlusSym0 a0123456789876543210 = PlusSym1 a0123456789876543210 instance SuppressUnusedWarnings (PlusSym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) PlusSym1KindInference) ()) data PlusSym1 (a0123456789876543210 :: Nat) :: (~>) Nat Nat @@ -56,14 +62,8 @@ Singletons/Nat.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (PlusSym1 a0123456789876543210) arg) (PlusSym2 a0123456789876543210 arg) => PlusSym1 a0123456789876543210 a0123456789876543210 type instance Apply (PlusSym1 a0123456789876543210) a0123456789876543210 = PlusSym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings PlusSym0 where - suppressUnusedWarnings = snd (((,) PlusSym0KindInference) ()) - data PlusSym0 :: (~>) Nat ((~>) Nat Nat) - where - PlusSym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply PlusSym0 arg) (PlusSym1 arg) => - PlusSym0 a0123456789876543210 - type instance Apply PlusSym0 a0123456789876543210 = PlusSym1 a0123456789876543210 + type PlusSym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) = + Plus a0123456789876543210 a0123456789876543210 type family Pred (a :: Nat) :: Nat where Pred Zero = ZeroSym0 Pred (Succ n) = n @@ -73,19 +73,15 @@ Singletons/Nat.hs:(0,0)-(0,0): Splicing declarations type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Nat) (a :: GHC.Types.Symbol) :: GHC.Types.Symbol where ShowsPrec_0123456789876543210 _ Zero a_0123456789876543210 = Apply (Apply ShowStringSym0 "Zero") a_0123456789876543210 ShowsPrec_0123456789876543210 p_0123456789876543210 (Succ arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (Data.Singletons.Prelude.Num.FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "Succ ")) (Apply (Apply ShowsPrecSym0 (Data.Singletons.Prelude.Num.FromInteger 11)) arg_0123456789876543210))) a_0123456789876543210 - type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Nat) (a0123456789876543210 :: GHC.Types.Symbol) = - ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where suppressUnusedWarnings - = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) - data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Nat) :: (~>) GHC.Types.Symbol GHC.Types.Symbol + = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) + data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Types.Nat ((~>) Nat ((~>) GHC.Types.Symbol GHC.Types.Symbol)) where - ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 - a0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => - ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 - type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 + ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => + ShowsPrec_0123456789876543210Sym0 a0123456789876543210 + type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ()) @@ -96,15 +92,19 @@ Singletons/Nat.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) => ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where + instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where suppressUnusedWarnings - = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) - data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Types.Nat ((~>) Nat ((~>) GHC.Types.Symbol GHC.Types.Symbol)) + = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) + data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Nat) :: (~>) GHC.Types.Symbol GHC.Types.Symbol where - ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => - ShowsPrec_0123456789876543210Sym0 a0123456789876543210 - type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 + ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 + a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => + ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Nat) (a0123456789876543210 :: GHC.Types.Symbol) = + ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance PShow Nat where type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a type family Compare_0123456789876543210 (a :: Nat) (a :: Nat) :: Ordering where @@ -112,8 +112,15 @@ Singletons/Nat.hs:(0,0)-(0,0): Splicing declarations Compare_0123456789876543210 (Succ a_0123456789876543210) (Succ b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[]) Compare_0123456789876543210 Zero (Succ _) = LTSym0 Compare_0123456789876543210 (Succ _) Zero = GTSym0 - type Compare_0123456789876543210Sym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) = - Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Compare_0123456789876543210Sym0KindInference) ()) + data Compare_0123456789876543210Sym0 :: (~>) Nat ((~>) Nat Ordering) + where + Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => + Compare_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 instance SuppressUnusedWarnings (Compare_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Compare_0123456789876543210Sym1KindInference) ()) @@ -124,15 +131,8 @@ Singletons/Nat.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Compare_0123456789876543210Sym1 a0123456789876543210) arg) (Compare_0123456789876543210Sym2 a0123456789876543210 arg) => Compare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Compare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Compare_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd (((,) Compare_0123456789876543210Sym0KindInference) ()) - data Compare_0123456789876543210Sym0 :: (~>) Nat ((~>) Nat Ordering) - where - Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => - Compare_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 + type Compare_0123456789876543210Sym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) = + Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance POrd Nat where type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a type family Equals_0123456789876543210 (a :: Nat) (b :: Nat) :: Bool where diff --git a/tests/compile-and-dump/Singletons/Operators.golden b/tests/compile-and-dump/Singletons/Operators.golden index 0058169e..10fbc143 100644 --- a/tests/compile-and-dump/Singletons/Operators.golden +++ b/tests/compile-and-dump/Singletons/Operators.golden @@ -23,8 +23,14 @@ Singletons/Operators.hs:(0,0)-(0,0): Splicing declarations (+) Zero m = m (+) (Succ n) m = Succ (n + m) type FLeafSym0 = FLeaf - type (:+:@#@$$$) (t0123456789876543210 :: Foo) (t0123456789876543210 :: Foo) = - (:+:) t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (:+:@#@$) where + suppressUnusedWarnings = snd (((,) (::+:@#@$###)) ()) + data (:+:@#@$) :: (~>) Foo ((~>) Foo Foo) + where + (::+:@#@$###) :: forall t0123456789876543210 + arg. SameKind (Apply (:+:@#@$) arg) ((:+:@#@$$) arg) => + (:+:@#@$) t0123456789876543210 + type instance Apply (:+:@#@$) t0123456789876543210 = (:+:@#@$$) t0123456789876543210 instance SuppressUnusedWarnings ((:+:@#@$$) t0123456789876543210) where suppressUnusedWarnings = snd (((,) (::+:@#@$$###)) ()) data (:+:@#@$$) (t0123456789876543210 :: Foo) :: (~>) Foo Foo @@ -34,16 +40,16 @@ Singletons/Operators.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply ((:+:@#@$$) t0123456789876543210) arg) ((:+:@#@$$$) t0123456789876543210 arg) => (:+:@#@$$) t0123456789876543210 t0123456789876543210 type instance Apply ((:+:@#@$$) t0123456789876543210) t0123456789876543210 = (:+:@#@$$$) t0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (:+:@#@$) where - suppressUnusedWarnings = snd (((,) (::+:@#@$###)) ()) - data (:+:@#@$) :: (~>) Foo ((~>) Foo Foo) + type (:+:@#@$$$) (t0123456789876543210 :: Foo) (t0123456789876543210 :: Foo) = + (:+:) t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (+@#@$) where + suppressUnusedWarnings = snd (((,) (:+@#@$###)) ()) + data (+@#@$) :: (~>) Nat ((~>) Nat Nat) where - (::+:@#@$###) :: forall t0123456789876543210 - arg. SameKind (Apply (:+:@#@$) arg) ((:+:@#@$$) arg) => - (:+:@#@$) t0123456789876543210 - type instance Apply (:+:@#@$) t0123456789876543210 = (:+:@#@$$) t0123456789876543210 - type (+@#@$$$) (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) = - (+) a0123456789876543210 a0123456789876543210 + (:+@#@$###) :: forall a0123456789876543210 + arg. SameKind (Apply (+@#@$) arg) ((+@#@$$) arg) => + (+@#@$) a0123456789876543210 + type instance Apply (+@#@$) a0123456789876543210 = (+@#@$$) a0123456789876543210 instance SuppressUnusedWarnings ((+@#@$$) a0123456789876543210) where suppressUnusedWarnings = snd (((,) (:+@#@$$###)) ()) data (+@#@$$) (a0123456789876543210 :: Nat) :: (~>) Nat Nat @@ -53,16 +59,8 @@ Singletons/Operators.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply ((+@#@$$) a0123456789876543210) arg) ((+@#@$$$) a0123456789876543210 arg) => (+@#@$$) a0123456789876543210 a0123456789876543210 type instance Apply ((+@#@$$) a0123456789876543210) a0123456789876543210 = (+@#@$$$) a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (+@#@$) where - suppressUnusedWarnings = snd (((,) (:+@#@$###)) ()) - data (+@#@$) :: (~>) Nat ((~>) Nat Nat) - where - (:+@#@$###) :: forall a0123456789876543210 - arg. SameKind (Apply (+@#@$) arg) ((+@#@$$) arg) => - (+@#@$) a0123456789876543210 - type instance Apply (+@#@$) a0123456789876543210 = (+@#@$$) a0123456789876543210 - type ChildSym1 (a0123456789876543210 :: Foo) = - Child a0123456789876543210 + type (+@#@$$$) (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) = + (+) a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings ChildSym0 where suppressUnusedWarnings = snd (((,) ChildSym0KindInference) ()) data ChildSym0 :: (~>) Foo Foo @@ -71,6 +69,8 @@ Singletons/Operators.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply ChildSym0 arg) (ChildSym1 arg) => ChildSym0 a0123456789876543210 type instance Apply ChildSym0 a0123456789876543210 = ChildSym1 a0123456789876543210 + type ChildSym1 (a0123456789876543210 :: Foo) = + Child a0123456789876543210 type family (+) (a :: Nat) (a :: Nat) :: Nat where (+) 'Zero m = m (+) ('Succ n) m = Apply SuccSym0 (Apply (Apply (+@#@$) n) m) diff --git a/tests/compile-and-dump/Singletons/OrdDeriving.golden b/tests/compile-and-dump/Singletons/OrdDeriving.golden index 9fa1bb86..125a1e8f 100644 --- a/tests/compile-and-dump/Singletons/OrdDeriving.golden +++ b/tests/compile-and-dump/Singletons/OrdDeriving.golden @@ -24,8 +24,6 @@ Singletons/OrdDeriving.hs:(0,0)-(0,0): Splicing declarations F a b c d deriving (Eq, Ord) type ZeroSym0 = Zero - type SuccSym1 (t0123456789876543210 :: Nat) = - Succ t0123456789876543210 instance SuppressUnusedWarnings SuccSym0 where suppressUnusedWarnings = snd (((,) SuccSym0KindInference) ()) data SuccSym0 :: (~>) Nat Nat @@ -34,20 +32,32 @@ Singletons/OrdDeriving.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply SuccSym0 arg) (SuccSym1 arg) => SuccSym0 t0123456789876543210 type instance Apply SuccSym0 t0123456789876543210 = SuccSym1 t0123456789876543210 - type ASym4 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) (t0123456789876543210 :: d0123456789876543210) = - A t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (ASym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) where - suppressUnusedWarnings = snd (((,) ASym3KindInference) ()) - data ASym3 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) :: forall d0123456789876543210. - (~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) + type SuccSym1 (t0123456789876543210 :: Nat) = + Succ t0123456789876543210 + instance SuppressUnusedWarnings ASym0 where + suppressUnusedWarnings = snd (((,) ASym0KindInference) ()) + data ASym0 :: forall a0123456789876543210 + b0123456789876543210 + c0123456789876543210 + d0123456789876543210. + (~>) a0123456789876543210 ((~>) b0123456789876543210 ((~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)))) where - ASym3KindInference :: forall t0123456789876543210 - t0123456789876543210 - t0123456789876543210 + ASym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply ASym0 arg) (ASym1 arg) => + ASym0 t0123456789876543210 + type instance Apply ASym0 t0123456789876543210 = ASym1 t0123456789876543210 + instance SuppressUnusedWarnings (ASym1 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) ASym1KindInference) ()) + data ASym1 (t0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210 + c0123456789876543210 + d0123456789876543210. + (~>) b0123456789876543210 ((~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210))) + where + ASym1KindInference :: forall t0123456789876543210 t0123456789876543210 - arg. SameKind (Apply (ASym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) arg) (ASym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 arg) => - ASym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 - type instance Apply (ASym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) t0123456789876543210 = ASym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 + arg. SameKind (Apply (ASym1 t0123456789876543210) arg) (ASym2 t0123456789876543210 arg) => + ASym1 t0123456789876543210 t0123456789876543210 + type instance Apply (ASym1 t0123456789876543210) t0123456789876543210 = ASym2 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (ASym2 t0123456789876543210 t0123456789876543210) where suppressUnusedWarnings = snd (((,) ASym2KindInference) ()) data ASym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) :: forall c0123456789876543210 @@ -60,44 +70,44 @@ Singletons/OrdDeriving.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (ASym2 t0123456789876543210 t0123456789876543210) arg) (ASym3 t0123456789876543210 t0123456789876543210 arg) => ASym2 t0123456789876543210 t0123456789876543210 t0123456789876543210 type instance Apply (ASym2 t0123456789876543210 t0123456789876543210) t0123456789876543210 = ASym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (ASym1 t0123456789876543210) where - suppressUnusedWarnings = snd (((,) ASym1KindInference) ()) - data ASym1 (t0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210 - c0123456789876543210 - d0123456789876543210. - (~>) b0123456789876543210 ((~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210))) + instance SuppressUnusedWarnings (ASym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) ASym3KindInference) ()) + data ASym3 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) :: forall d0123456789876543210. + (~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) where - ASym1KindInference :: forall t0123456789876543210 + ASym3KindInference :: forall t0123456789876543210 t0123456789876543210 - arg. SameKind (Apply (ASym1 t0123456789876543210) arg) (ASym2 t0123456789876543210 arg) => - ASym1 t0123456789876543210 t0123456789876543210 - type instance Apply (ASym1 t0123456789876543210) t0123456789876543210 = ASym2 t0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings ASym0 where - suppressUnusedWarnings = snd (((,) ASym0KindInference) ()) - data ASym0 :: forall a0123456789876543210 + t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (ASym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) arg) (ASym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 arg) => + ASym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 + type instance Apply (ASym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) t0123456789876543210 = ASym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 + type ASym4 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) (t0123456789876543210 :: d0123456789876543210) = + A t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings BSym0 where + suppressUnusedWarnings = snd (((,) BSym0KindInference) ()) + data BSym0 :: forall a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210. (~>) a0123456789876543210 ((~>) b0123456789876543210 ((~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)))) where - ASym0KindInference :: forall t0123456789876543210 - arg. SameKind (Apply ASym0 arg) (ASym1 arg) => - ASym0 t0123456789876543210 - type instance Apply ASym0 t0123456789876543210 = ASym1 t0123456789876543210 - type BSym4 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) (t0123456789876543210 :: d0123456789876543210) = - B t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (BSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) where - suppressUnusedWarnings = snd (((,) BSym3KindInference) ()) - data BSym3 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) :: forall d0123456789876543210. - (~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) + BSym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply BSym0 arg) (BSym1 arg) => + BSym0 t0123456789876543210 + type instance Apply BSym0 t0123456789876543210 = BSym1 t0123456789876543210 + instance SuppressUnusedWarnings (BSym1 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) BSym1KindInference) ()) + data BSym1 (t0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210 + c0123456789876543210 + d0123456789876543210. + (~>) b0123456789876543210 ((~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210))) where - BSym3KindInference :: forall t0123456789876543210 - t0123456789876543210 - t0123456789876543210 + BSym1KindInference :: forall t0123456789876543210 t0123456789876543210 - arg. SameKind (Apply (BSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) arg) (BSym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 arg) => - BSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 - type instance Apply (BSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) t0123456789876543210 = BSym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 + arg. SameKind (Apply (BSym1 t0123456789876543210) arg) (BSym2 t0123456789876543210 arg) => + BSym1 t0123456789876543210 t0123456789876543210 + type instance Apply (BSym1 t0123456789876543210) t0123456789876543210 = BSym2 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (BSym2 t0123456789876543210 t0123456789876543210) where suppressUnusedWarnings = snd (((,) BSym2KindInference) ()) data BSym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) :: forall c0123456789876543210 @@ -110,44 +120,44 @@ Singletons/OrdDeriving.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (BSym2 t0123456789876543210 t0123456789876543210) arg) (BSym3 t0123456789876543210 t0123456789876543210 arg) => BSym2 t0123456789876543210 t0123456789876543210 t0123456789876543210 type instance Apply (BSym2 t0123456789876543210 t0123456789876543210) t0123456789876543210 = BSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (BSym1 t0123456789876543210) where - suppressUnusedWarnings = snd (((,) BSym1KindInference) ()) - data BSym1 (t0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210 - c0123456789876543210 - d0123456789876543210. - (~>) b0123456789876543210 ((~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210))) + instance SuppressUnusedWarnings (BSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) BSym3KindInference) ()) + data BSym3 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) :: forall d0123456789876543210. + (~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) where - BSym1KindInference :: forall t0123456789876543210 + BSym3KindInference :: forall t0123456789876543210 t0123456789876543210 - arg. SameKind (Apply (BSym1 t0123456789876543210) arg) (BSym2 t0123456789876543210 arg) => - BSym1 t0123456789876543210 t0123456789876543210 - type instance Apply (BSym1 t0123456789876543210) t0123456789876543210 = BSym2 t0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings BSym0 where - suppressUnusedWarnings = snd (((,) BSym0KindInference) ()) - data BSym0 :: forall a0123456789876543210 + t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (BSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) arg) (BSym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 arg) => + BSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 + type instance Apply (BSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) t0123456789876543210 = BSym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 + type BSym4 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) (t0123456789876543210 :: d0123456789876543210) = + B t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings CSym0 where + suppressUnusedWarnings = snd (((,) CSym0KindInference) ()) + data CSym0 :: forall a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210. (~>) a0123456789876543210 ((~>) b0123456789876543210 ((~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)))) where - BSym0KindInference :: forall t0123456789876543210 - arg. SameKind (Apply BSym0 arg) (BSym1 arg) => - BSym0 t0123456789876543210 - type instance Apply BSym0 t0123456789876543210 = BSym1 t0123456789876543210 - type CSym4 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) (t0123456789876543210 :: d0123456789876543210) = - C t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (CSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) where - suppressUnusedWarnings = snd (((,) CSym3KindInference) ()) - data CSym3 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) :: forall d0123456789876543210. - (~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) + CSym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply CSym0 arg) (CSym1 arg) => + CSym0 t0123456789876543210 + type instance Apply CSym0 t0123456789876543210 = CSym1 t0123456789876543210 + instance SuppressUnusedWarnings (CSym1 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) CSym1KindInference) ()) + data CSym1 (t0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210 + c0123456789876543210 + d0123456789876543210. + (~>) b0123456789876543210 ((~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210))) where - CSym3KindInference :: forall t0123456789876543210 - t0123456789876543210 - t0123456789876543210 + CSym1KindInference :: forall t0123456789876543210 t0123456789876543210 - arg. SameKind (Apply (CSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) arg) (CSym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 arg) => - CSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 - type instance Apply (CSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) t0123456789876543210 = CSym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 + arg. SameKind (Apply (CSym1 t0123456789876543210) arg) (CSym2 t0123456789876543210 arg) => + CSym1 t0123456789876543210 t0123456789876543210 + type instance Apply (CSym1 t0123456789876543210) t0123456789876543210 = CSym2 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (CSym2 t0123456789876543210 t0123456789876543210) where suppressUnusedWarnings = snd (((,) CSym2KindInference) ()) data CSym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) :: forall c0123456789876543210 @@ -160,44 +170,44 @@ Singletons/OrdDeriving.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (CSym2 t0123456789876543210 t0123456789876543210) arg) (CSym3 t0123456789876543210 t0123456789876543210 arg) => CSym2 t0123456789876543210 t0123456789876543210 t0123456789876543210 type instance Apply (CSym2 t0123456789876543210 t0123456789876543210) t0123456789876543210 = CSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (CSym1 t0123456789876543210) where - suppressUnusedWarnings = snd (((,) CSym1KindInference) ()) - data CSym1 (t0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210 - c0123456789876543210 - d0123456789876543210. - (~>) b0123456789876543210 ((~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210))) + instance SuppressUnusedWarnings (CSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) CSym3KindInference) ()) + data CSym3 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) :: forall d0123456789876543210. + (~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) where - CSym1KindInference :: forall t0123456789876543210 + CSym3KindInference :: forall t0123456789876543210 t0123456789876543210 - arg. SameKind (Apply (CSym1 t0123456789876543210) arg) (CSym2 t0123456789876543210 arg) => - CSym1 t0123456789876543210 t0123456789876543210 - type instance Apply (CSym1 t0123456789876543210) t0123456789876543210 = CSym2 t0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings CSym0 where - suppressUnusedWarnings = snd (((,) CSym0KindInference) ()) - data CSym0 :: forall a0123456789876543210 + t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (CSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) arg) (CSym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 arg) => + CSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 + type instance Apply (CSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) t0123456789876543210 = CSym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 + type CSym4 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) (t0123456789876543210 :: d0123456789876543210) = + C t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings DSym0 where + suppressUnusedWarnings = snd (((,) DSym0KindInference) ()) + data DSym0 :: forall a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210. (~>) a0123456789876543210 ((~>) b0123456789876543210 ((~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)))) where - CSym0KindInference :: forall t0123456789876543210 - arg. SameKind (Apply CSym0 arg) (CSym1 arg) => - CSym0 t0123456789876543210 - type instance Apply CSym0 t0123456789876543210 = CSym1 t0123456789876543210 - type DSym4 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) (t0123456789876543210 :: d0123456789876543210) = - D t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (DSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) where - suppressUnusedWarnings = snd (((,) DSym3KindInference) ()) - data DSym3 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) :: forall d0123456789876543210. - (~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) + DSym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply DSym0 arg) (DSym1 arg) => + DSym0 t0123456789876543210 + type instance Apply DSym0 t0123456789876543210 = DSym1 t0123456789876543210 + instance SuppressUnusedWarnings (DSym1 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) DSym1KindInference) ()) + data DSym1 (t0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210 + c0123456789876543210 + d0123456789876543210. + (~>) b0123456789876543210 ((~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210))) where - DSym3KindInference :: forall t0123456789876543210 - t0123456789876543210 - t0123456789876543210 + DSym1KindInference :: forall t0123456789876543210 t0123456789876543210 - arg. SameKind (Apply (DSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) arg) (DSym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 arg) => - DSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 - type instance Apply (DSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) t0123456789876543210 = DSym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 + arg. SameKind (Apply (DSym1 t0123456789876543210) arg) (DSym2 t0123456789876543210 arg) => + DSym1 t0123456789876543210 t0123456789876543210 + type instance Apply (DSym1 t0123456789876543210) t0123456789876543210 = DSym2 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (DSym2 t0123456789876543210 t0123456789876543210) where suppressUnusedWarnings = snd (((,) DSym2KindInference) ()) data DSym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) :: forall c0123456789876543210 @@ -210,44 +220,44 @@ Singletons/OrdDeriving.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (DSym2 t0123456789876543210 t0123456789876543210) arg) (DSym3 t0123456789876543210 t0123456789876543210 arg) => DSym2 t0123456789876543210 t0123456789876543210 t0123456789876543210 type instance Apply (DSym2 t0123456789876543210 t0123456789876543210) t0123456789876543210 = DSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (DSym1 t0123456789876543210) where - suppressUnusedWarnings = snd (((,) DSym1KindInference) ()) - data DSym1 (t0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210 - c0123456789876543210 - d0123456789876543210. - (~>) b0123456789876543210 ((~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210))) + instance SuppressUnusedWarnings (DSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) DSym3KindInference) ()) + data DSym3 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) :: forall d0123456789876543210. + (~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) where - DSym1KindInference :: forall t0123456789876543210 + DSym3KindInference :: forall t0123456789876543210 t0123456789876543210 - arg. SameKind (Apply (DSym1 t0123456789876543210) arg) (DSym2 t0123456789876543210 arg) => - DSym1 t0123456789876543210 t0123456789876543210 - type instance Apply (DSym1 t0123456789876543210) t0123456789876543210 = DSym2 t0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings DSym0 where - suppressUnusedWarnings = snd (((,) DSym0KindInference) ()) - data DSym0 :: forall a0123456789876543210 + t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (DSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) arg) (DSym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 arg) => + DSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 + type instance Apply (DSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) t0123456789876543210 = DSym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 + type DSym4 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) (t0123456789876543210 :: d0123456789876543210) = + D t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings ESym0 where + suppressUnusedWarnings = snd (((,) ESym0KindInference) ()) + data ESym0 :: forall a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210. (~>) a0123456789876543210 ((~>) b0123456789876543210 ((~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)))) where - DSym0KindInference :: forall t0123456789876543210 - arg. SameKind (Apply DSym0 arg) (DSym1 arg) => - DSym0 t0123456789876543210 - type instance Apply DSym0 t0123456789876543210 = DSym1 t0123456789876543210 - type ESym4 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) (t0123456789876543210 :: d0123456789876543210) = - E t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (ESym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) where - suppressUnusedWarnings = snd (((,) ESym3KindInference) ()) - data ESym3 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) :: forall d0123456789876543210. - (~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) + ESym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply ESym0 arg) (ESym1 arg) => + ESym0 t0123456789876543210 + type instance Apply ESym0 t0123456789876543210 = ESym1 t0123456789876543210 + instance SuppressUnusedWarnings (ESym1 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) ESym1KindInference) ()) + data ESym1 (t0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210 + c0123456789876543210 + d0123456789876543210. + (~>) b0123456789876543210 ((~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210))) where - ESym3KindInference :: forall t0123456789876543210 - t0123456789876543210 - t0123456789876543210 + ESym1KindInference :: forall t0123456789876543210 t0123456789876543210 - arg. SameKind (Apply (ESym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) arg) (ESym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 arg) => - ESym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 - type instance Apply (ESym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) t0123456789876543210 = ESym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 + arg. SameKind (Apply (ESym1 t0123456789876543210) arg) (ESym2 t0123456789876543210 arg) => + ESym1 t0123456789876543210 t0123456789876543210 + type instance Apply (ESym1 t0123456789876543210) t0123456789876543210 = ESym2 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (ESym2 t0123456789876543210 t0123456789876543210) where suppressUnusedWarnings = snd (((,) ESym2KindInference) ()) data ESym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) :: forall c0123456789876543210 @@ -260,44 +270,44 @@ Singletons/OrdDeriving.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (ESym2 t0123456789876543210 t0123456789876543210) arg) (ESym3 t0123456789876543210 t0123456789876543210 arg) => ESym2 t0123456789876543210 t0123456789876543210 t0123456789876543210 type instance Apply (ESym2 t0123456789876543210 t0123456789876543210) t0123456789876543210 = ESym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (ESym1 t0123456789876543210) where - suppressUnusedWarnings = snd (((,) ESym1KindInference) ()) - data ESym1 (t0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210 - c0123456789876543210 - d0123456789876543210. - (~>) b0123456789876543210 ((~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210))) + instance SuppressUnusedWarnings (ESym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) ESym3KindInference) ()) + data ESym3 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) :: forall d0123456789876543210. + (~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) where - ESym1KindInference :: forall t0123456789876543210 + ESym3KindInference :: forall t0123456789876543210 t0123456789876543210 - arg. SameKind (Apply (ESym1 t0123456789876543210) arg) (ESym2 t0123456789876543210 arg) => - ESym1 t0123456789876543210 t0123456789876543210 - type instance Apply (ESym1 t0123456789876543210) t0123456789876543210 = ESym2 t0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings ESym0 where - suppressUnusedWarnings = snd (((,) ESym0KindInference) ()) - data ESym0 :: forall a0123456789876543210 + t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (ESym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) arg) (ESym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 arg) => + ESym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 + type instance Apply (ESym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) t0123456789876543210 = ESym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 + type ESym4 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) (t0123456789876543210 :: d0123456789876543210) = + E t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings FSym0 where + suppressUnusedWarnings = snd (((,) FSym0KindInference) ()) + data FSym0 :: forall a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210. (~>) a0123456789876543210 ((~>) b0123456789876543210 ((~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)))) where - ESym0KindInference :: forall t0123456789876543210 - arg. SameKind (Apply ESym0 arg) (ESym1 arg) => - ESym0 t0123456789876543210 - type instance Apply ESym0 t0123456789876543210 = ESym1 t0123456789876543210 - type FSym4 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) (t0123456789876543210 :: d0123456789876543210) = - F t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (FSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) where - suppressUnusedWarnings = snd (((,) FSym3KindInference) ()) - data FSym3 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) :: forall d0123456789876543210. - (~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) + FSym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply FSym0 arg) (FSym1 arg) => + FSym0 t0123456789876543210 + type instance Apply FSym0 t0123456789876543210 = FSym1 t0123456789876543210 + instance SuppressUnusedWarnings (FSym1 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) FSym1KindInference) ()) + data FSym1 (t0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210 + c0123456789876543210 + d0123456789876543210. + (~>) b0123456789876543210 ((~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210))) where - FSym3KindInference :: forall t0123456789876543210 - t0123456789876543210 - t0123456789876543210 + FSym1KindInference :: forall t0123456789876543210 t0123456789876543210 - arg. SameKind (Apply (FSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) arg) (FSym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 arg) => - FSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 - type instance Apply (FSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) t0123456789876543210 = FSym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 + arg. SameKind (Apply (FSym1 t0123456789876543210) arg) (FSym2 t0123456789876543210 arg) => + FSym1 t0123456789876543210 t0123456789876543210 + type instance Apply (FSym1 t0123456789876543210) t0123456789876543210 = FSym2 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (FSym2 t0123456789876543210 t0123456789876543210) where suppressUnusedWarnings = snd (((,) FSym2KindInference) ()) data FSym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) :: forall c0123456789876543210 @@ -310,37 +320,34 @@ Singletons/OrdDeriving.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (FSym2 t0123456789876543210 t0123456789876543210) arg) (FSym3 t0123456789876543210 t0123456789876543210 arg) => FSym2 t0123456789876543210 t0123456789876543210 t0123456789876543210 type instance Apply (FSym2 t0123456789876543210 t0123456789876543210) t0123456789876543210 = FSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (FSym1 t0123456789876543210) where - suppressUnusedWarnings = snd (((,) FSym1KindInference) ()) - data FSym1 (t0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210 - c0123456789876543210 - d0123456789876543210. - (~>) b0123456789876543210 ((~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210))) + instance SuppressUnusedWarnings (FSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) FSym3KindInference) ()) + data FSym3 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) :: forall d0123456789876543210. + (~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) where - FSym1KindInference :: forall t0123456789876543210 + FSym3KindInference :: forall t0123456789876543210 t0123456789876543210 - arg. SameKind (Apply (FSym1 t0123456789876543210) arg) (FSym2 t0123456789876543210 arg) => - FSym1 t0123456789876543210 t0123456789876543210 - type instance Apply (FSym1 t0123456789876543210) t0123456789876543210 = FSym2 t0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings FSym0 where - suppressUnusedWarnings = snd (((,) FSym0KindInference) ()) - data FSym0 :: forall a0123456789876543210 - b0123456789876543210 - c0123456789876543210 - d0123456789876543210. - (~>) a0123456789876543210 ((~>) b0123456789876543210 ((~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)))) - where - FSym0KindInference :: forall t0123456789876543210 - arg. SameKind (Apply FSym0 arg) (FSym1 arg) => - FSym0 t0123456789876543210 - type instance Apply FSym0 t0123456789876543210 = FSym1 t0123456789876543210 + t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (FSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) arg) (FSym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 arg) => + FSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 + type instance Apply (FSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) t0123456789876543210 = FSym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 + type FSym4 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) (t0123456789876543210 :: d0123456789876543210) = + F t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 type family Compare_0123456789876543210 (a :: Nat) (a :: Nat) :: Ordering where Compare_0123456789876543210 Zero Zero = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] Compare_0123456789876543210 (Succ a_0123456789876543210) (Succ b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[]) Compare_0123456789876543210 Zero (Succ _) = LTSym0 Compare_0123456789876543210 (Succ _) Zero = GTSym0 - type Compare_0123456789876543210Sym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) = - Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Compare_0123456789876543210Sym0KindInference) ()) + data Compare_0123456789876543210Sym0 :: (~>) Nat ((~>) Nat Ordering) + where + Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => + Compare_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 instance SuppressUnusedWarnings (Compare_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Compare_0123456789876543210Sym1KindInference) ()) @@ -351,15 +358,8 @@ Singletons/OrdDeriving.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Compare_0123456789876543210Sym1 a0123456789876543210) arg) (Compare_0123456789876543210Sym2 a0123456789876543210 arg) => Compare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Compare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Compare_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd (((,) Compare_0123456789876543210Sym0KindInference) ()) - data Compare_0123456789876543210Sym0 :: (~>) Nat ((~>) Nat Ordering) - where - Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => - Compare_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 + type Compare_0123456789876543210Sym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) = + Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance POrd Nat where type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a type family Compare_0123456789876543210 (a :: Foo a b c d) (a :: Foo a b c d) :: Ordering where @@ -399,18 +399,6 @@ Singletons/OrdDeriving.hs:(0,0)-(0,0): Splicing declarations Compare_0123456789876543210 (F _ _ _ _) (C _ _ _ _) = GTSym0 Compare_0123456789876543210 (F _ _ _ _) (D _ _ _ _) = GTSym0 Compare_0123456789876543210 (F _ _ _ _) (E _ _ _ _) = GTSym0 - type Compare_0123456789876543210Sym2 (a0123456789876543210 :: Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) (a0123456789876543210 :: Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) = - Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (Compare_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd (((,) Compare_0123456789876543210Sym1KindInference) ()) - data Compare_0123456789876543210Sym1 (a0123456789876543210 :: Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) :: (~>) (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) Ordering - where - Compare_0123456789876543210Sym1KindInference :: forall a0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply (Compare_0123456789876543210Sym1 a0123456789876543210) arg) (Compare_0123456789876543210Sym2 a0123456789876543210 arg) => - Compare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 - type instance Apply (Compare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Compare_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Compare_0123456789876543210Sym0KindInference) ()) @@ -424,6 +412,18 @@ Singletons/OrdDeriving.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => Compare_0123456789876543210Sym0 a0123456789876543210 type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 + instance SuppressUnusedWarnings (Compare_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Compare_0123456789876543210Sym1KindInference) ()) + data Compare_0123456789876543210Sym1 (a0123456789876543210 :: Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) :: (~>) (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) Ordering + where + Compare_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Compare_0123456789876543210Sym1 a0123456789876543210) arg) (Compare_0123456789876543210Sym2 a0123456789876543210 arg) => + Compare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Compare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Compare_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 + type Compare_0123456789876543210Sym2 (a0123456789876543210 :: Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) (a0123456789876543210 :: Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) = + Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance POrd (Foo a b c d) where type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a type family Equals_0123456789876543210 (a :: Nat) (b :: Nat) :: Bool where diff --git a/tests/compile-and-dump/Singletons/OverloadedStrings.golden b/tests/compile-and-dump/Singletons/OverloadedStrings.golden index 769a88f8..07ac07bc 100644 --- a/tests/compile-and-dump/Singletons/OverloadedStrings.golden +++ b/tests/compile-and-dump/Singletons/OverloadedStrings.golden @@ -10,8 +10,6 @@ Singletons/OverloadedStrings.hs:(0,0)-(0,0): Splicing declarations foo :: Symbol foo = symId "foo" type FooSym0 = Foo - type SymIdSym1 (a0123456789876543210 :: Symbol) = - SymId a0123456789876543210 instance SuppressUnusedWarnings SymIdSym0 where suppressUnusedWarnings = snd (((,) SymIdSym0KindInference) ()) data SymIdSym0 :: (~>) Symbol Symbol @@ -20,6 +18,8 @@ Singletons/OverloadedStrings.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply SymIdSym0 arg) (SymIdSym1 arg) => SymIdSym0 a0123456789876543210 type instance Apply SymIdSym0 a0123456789876543210 = SymIdSym1 a0123456789876543210 + type SymIdSym1 (a0123456789876543210 :: Symbol) = + SymId a0123456789876543210 type family Foo :: Symbol where Foo = Apply SymIdSym0 (Data.Singletons.Prelude.IsString.FromString "foo") type family SymId (a :: Symbol) :: Symbol where diff --git a/tests/compile-and-dump/Singletons/PatternMatching.golden b/tests/compile-and-dump/Singletons/PatternMatching.golden index d9d88722..9d2d6e77 100644 --- a/tests/compile-and-dump/Singletons/PatternMatching.golden +++ b/tests/compile-and-dump/Singletons/PatternMatching.golden @@ -16,8 +16,15 @@ Singletons/PatternMatching.hs:(0,0)-(0,0): Splicing declarations complex = (Pair ((Pair (Just Zero)) Zero)) False tuple = (False, Just Zero, True) aList = [Zero, Succ Zero, Succ (Succ Zero)] - type PairSym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) = - Pair t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings PairSym0 where + suppressUnusedWarnings = snd (((,) PairSym0KindInference) ()) + data PairSym0 :: forall a0123456789876543210 b0123456789876543210. + (~>) a0123456789876543210 ((~>) b0123456789876543210 (Pair a0123456789876543210 b0123456789876543210)) + where + PairSym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply PairSym0 arg) (PairSym1 arg) => + PairSym0 t0123456789876543210 + type instance Apply PairSym0 t0123456789876543210 = PairSym1 t0123456789876543210 instance SuppressUnusedWarnings (PairSym1 t0123456789876543210) where suppressUnusedWarnings = snd (((,) PairSym1KindInference) ()) data PairSym1 (t0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. @@ -28,15 +35,8 @@ Singletons/PatternMatching.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (PairSym1 t0123456789876543210) arg) (PairSym2 t0123456789876543210 arg) => PairSym1 t0123456789876543210 t0123456789876543210 type instance Apply (PairSym1 t0123456789876543210) t0123456789876543210 = PairSym2 t0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings PairSym0 where - suppressUnusedWarnings = snd (((,) PairSym0KindInference) ()) - data PairSym0 :: forall a0123456789876543210 b0123456789876543210. - (~>) a0123456789876543210 ((~>) b0123456789876543210 (Pair a0123456789876543210 b0123456789876543210)) - where - PairSym0KindInference :: forall t0123456789876543210 - arg. SameKind (Apply PairSym0 arg) (PairSym1 arg) => - PairSym0 t0123456789876543210 - type instance Apply PairSym0 t0123456789876543210 = PairSym1 t0123456789876543210 + type PairSym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) = + Pair t0123456789876543210 t0123456789876543210 type AListSym0 = AList type TupleSym0 = Tuple type ComplexSym0 = Complex @@ -51,19 +51,17 @@ Singletons/PatternMatching.hs:(0,0)-(0,0): Splicing declarations Pr = Apply (Apply PairSym0 (Apply SuccSym0 ZeroSym0)) (Apply (Apply (:@#@$) ZeroSym0) '[]) type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Pair a b) (a :: Symbol) :: Symbol where ShowsPrec_0123456789876543210 p_0123456789876543210 (Pair arg_0123456789876543210 arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "Pair ")) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210)) (Apply (Apply (.@#@$) ShowSpaceSym0) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210))))) a_0123456789876543210 - type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Pair a0123456789876543210 b0123456789876543210) (a0123456789876543210 :: Symbol) = - ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where suppressUnusedWarnings - = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) - data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Pair a0123456789876543210 b0123456789876543210) :: (~>) Symbol Symbol + = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) + data ShowsPrec_0123456789876543210Sym0 :: forall a0123456789876543210 + b0123456789876543210. + (~>) GHC.Types.Nat ((~>) (Pair a0123456789876543210 b0123456789876543210) ((~>) Symbol Symbol)) where - ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 - a0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => - ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 - type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 + ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => + ShowsPrec_0123456789876543210Sym0 a0123456789876543210 + type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ()) @@ -76,17 +74,19 @@ Singletons/PatternMatching.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) => ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where + instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where suppressUnusedWarnings - = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) - data ShowsPrec_0123456789876543210Sym0 :: forall a0123456789876543210 - b0123456789876543210. - (~>) GHC.Types.Nat ((~>) (Pair a0123456789876543210 b0123456789876543210) ((~>) Symbol Symbol)) + = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) + data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Pair a0123456789876543210 b0123456789876543210) :: (~>) Symbol Symbol where - ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => - ShowsPrec_0123456789876543210Sym0 a0123456789876543210 - type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 + ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 + a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => + ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Pair a0123456789876543210 b0123456789876543210) (a0123456789876543210 :: Symbol) = + ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance PShow (Pair a b) where type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a sAList :: Sing AListSym0 @@ -220,8 +220,15 @@ Singletons/PatternMatching.hs:(0,0)-(0,0): Splicing declarations silly x = case x of { _ -> () } type family Case_0123456789876543210 x t where Case_0123456789876543210 x _ = Tuple0Sym0 - type Let0123456789876543210TSym2 x0123456789876543210 y0123456789876543210 = - Let0123456789876543210T x0123456789876543210 y0123456789876543210 + instance SuppressUnusedWarnings Let0123456789876543210TSym0 where + suppressUnusedWarnings + = snd (((,) Let0123456789876543210TSym0KindInference) ()) + data Let0123456789876543210TSym0 x0123456789876543210 + where + Let0123456789876543210TSym0KindInference :: forall x0123456789876543210 + arg. SameKind (Apply Let0123456789876543210TSym0 arg) (Let0123456789876543210TSym1 arg) => + Let0123456789876543210TSym0 x0123456789876543210 + type instance Apply Let0123456789876543210TSym0 x0123456789876543210 = Let0123456789876543210TSym1 x0123456789876543210 instance SuppressUnusedWarnings (Let0123456789876543210TSym1 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Let0123456789876543210TSym1KindInference) ()) @@ -232,49 +239,34 @@ Singletons/PatternMatching.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Let0123456789876543210TSym1 x0123456789876543210) arg) (Let0123456789876543210TSym2 x0123456789876543210 arg) => Let0123456789876543210TSym1 x0123456789876543210 y0123456789876543210 type instance Apply (Let0123456789876543210TSym1 x0123456789876543210) y0123456789876543210 = Let0123456789876543210TSym2 x0123456789876543210 y0123456789876543210 - instance SuppressUnusedWarnings Let0123456789876543210TSym0 where - suppressUnusedWarnings - = snd (((,) Let0123456789876543210TSym0KindInference) ()) - data Let0123456789876543210TSym0 x0123456789876543210 - where - Let0123456789876543210TSym0KindInference :: forall x0123456789876543210 - arg. SameKind (Apply Let0123456789876543210TSym0 arg) (Let0123456789876543210TSym1 arg) => - Let0123456789876543210TSym0 x0123456789876543210 - type instance Apply Let0123456789876543210TSym0 x0123456789876543210 = Let0123456789876543210TSym1 x0123456789876543210 + type Let0123456789876543210TSym2 x0123456789876543210 y0123456789876543210 = + Let0123456789876543210T x0123456789876543210 y0123456789876543210 type family Let0123456789876543210T x y where Let0123456789876543210T x y = Apply (Apply Tuple2Sym0 x) y type family Case_0123456789876543210 arg_0123456789876543210 a b x y t where Case_0123456789876543210 arg_0123456789876543210 a b x y _ = a type family Lambda_0123456789876543210 a b x y t where Lambda_0123456789876543210 a b x y arg_0123456789876543210 = Case_0123456789876543210 arg_0123456789876543210 a b x y arg_0123456789876543210 - type Lambda_0123456789876543210Sym5 a0123456789876543210 b0123456789876543210 x0123456789876543210 y0123456789876543210 t0123456789876543210 = - Lambda_0123456789876543210 a0123456789876543210 b0123456789876543210 x0123456789876543210 y0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 y0123456789876543210 x0123456789876543210 b0123456789876543210 a0123456789876543210) where + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym4KindInference) ()) - data Lambda_0123456789876543210Sym4 a0123456789876543210 b0123456789876543210 x0123456789876543210 y0123456789876543210 t0123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 a0123456789876543210 where - Lambda_0123456789876543210Sym4KindInference :: forall a0123456789876543210 - b0123456789876543210 - x0123456789876543210 - y0123456789876543210 - t0123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym4 a0123456789876543210 b0123456789876543210 x0123456789876543210 y0123456789876543210) arg) (Lambda_0123456789876543210Sym5 a0123456789876543210 b0123456789876543210 x0123456789876543210 y0123456789876543210 arg) => - Lambda_0123456789876543210Sym4 a0123456789876543210 b0123456789876543210 x0123456789876543210 y0123456789876543210 t0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym4 y0123456789876543210 x0123456789876543210 b0123456789876543210 a0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym5 y0123456789876543210 x0123456789876543210 b0123456789876543210 a0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 x0123456789876543210 b0123456789876543210 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 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) - data Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 x0123456789876543210 y0123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) + data Lambda_0123456789876543210Sym1 a0123456789876543210 b0123456789876543210 where - Lambda_0123456789876543210Sym3KindInference :: forall a0123456789876543210 + Lambda_0123456789876543210Sym1KindInference :: forall a0123456789876543210 b0123456789876543210 - x0123456789876543210 - y0123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 x0123456789876543210) arg) (Lambda_0123456789876543210Sym4 a0123456789876543210 b0123456789876543210 x0123456789876543210 arg) => - Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 x0123456789876543210 y0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym3 x0123456789876543210 b0123456789876543210 a0123456789876543210) y0123456789876543210 = Lambda_0123456789876543210Sym4 x0123456789876543210 b0123456789876543210 a0123456789876543210 y0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 b0123456789876543210 a0123456789876543210) where + 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_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) data Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210 x0123456789876543210 @@ -284,26 +276,34 @@ Singletons/PatternMatching.hs:(0,0)-(0,0): Splicing declarations 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 + type instance Apply (Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210) x0123456789876543210 = Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 x0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 x0123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) - data Lambda_0123456789876543210Sym1 a0123456789876543210 b0123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) + data Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 x0123456789876543210 y0123456789876543210 where - Lambda_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + Lambda_0123456789876543210Sym3KindInference :: 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 + x0123456789876543210 + y0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 x0123456789876543210) arg) (Lambda_0123456789876543210Sym4 a0123456789876543210 b0123456789876543210 x0123456789876543210 arg) => + Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 x0123456789876543210 y0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 x0123456789876543210) y0123456789876543210 = Lambda_0123456789876543210Sym4 a0123456789876543210 b0123456789876543210 x0123456789876543210 y0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 a0123456789876543210 b0123456789876543210 x0123456789876543210 y0123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) - data Lambda_0123456789876543210Sym0 a0123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym4KindInference) ()) + data Lambda_0123456789876543210Sym4 a0123456789876543210 b0123456789876543210 x0123456789876543210 y0123456789876543210 t0123456789876543210 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 + Lambda_0123456789876543210Sym4KindInference :: forall a0123456789876543210 + b0123456789876543210 + x0123456789876543210 + y0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym4 a0123456789876543210 b0123456789876543210 x0123456789876543210 y0123456789876543210) arg) (Lambda_0123456789876543210Sym5 a0123456789876543210 b0123456789876543210 x0123456789876543210 y0123456789876543210 arg) => + Lambda_0123456789876543210Sym4 a0123456789876543210 b0123456789876543210 x0123456789876543210 y0123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym4 a0123456789876543210 b0123456789876543210 x0123456789876543210 y0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym5 a0123456789876543210 b0123456789876543210 x0123456789876543210 y0123456789876543210 t0123456789876543210 + type Lambda_0123456789876543210Sym5 a0123456789876543210 b0123456789876543210 x0123456789876543210 y0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 a0123456789876543210 b0123456789876543210 x0123456789876543210 y0123456789876543210 t0123456789876543210 type family Case_0123456789876543210 x y t where Case_0123456789876543210 x y '(a, b) = Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 a) b) x) y) b @@ -311,19 +311,15 @@ Singletons/PatternMatching.hs:(0,0)-(0,0): Splicing declarations Case_0123456789876543210 arg_0123456789876543210 x y _ = x type family Lambda_0123456789876543210 x y t where Lambda_0123456789876543210 x y arg_0123456789876543210 = Case_0123456789876543210 arg_0123456789876543210 x y arg_0123456789876543210 - type Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 t0123456789876543210 = - Lambda_0123456789876543210 x0123456789876543210 y0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) where + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) - data Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 t0123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 x0123456789876543210 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_0123456789876543210Sym3 y0123456789876543210 x0123456789876543210 t0123456789876543210 + 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 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) @@ -334,15 +330,19 @@ Singletons/PatternMatching.hs:(0,0)-(0,0): Splicing declarations 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 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) - data Lambda_0123456789876543210Sym0 x0123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 t0123456789876543210 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 + 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 x0123456789876543210 y0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 t0123456789876543210 + type Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 x0123456789876543210 y0123456789876543210 t0123456789876543210 type family Case_0123456789876543210 t where Case_0123456789876543210 '[_, _, @@ -373,8 +373,6 @@ Singletons/PatternMatching.hs:(0,0)-(0,0): Splicing declarations Case_0123456789876543210 ('Pair _ y_0123456789876543210) = y_0123456789876543210 type family Case_0123456789876543210 t where Case_0123456789876543210 ('Pair y_0123456789876543210 _) = y_0123456789876543210 - type SillySym1 (a0123456789876543210 :: a0123456789876543210) = - Silly a0123456789876543210 instance SuppressUnusedWarnings SillySym0 where suppressUnusedWarnings = snd (((,) SillySym0KindInference) ()) data SillySym0 :: forall a0123456789876543210. @@ -384,9 +382,8 @@ Singletons/PatternMatching.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply SillySym0 arg) (SillySym1 arg) => SillySym0 a0123456789876543210 type instance Apply SillySym0 a0123456789876543210 = SillySym1 a0123456789876543210 - type Foo2Sym1 (a0123456789876543210 :: (a0123456789876543210, - b0123456789876543210)) = - Foo2 a0123456789876543210 + type SillySym1 (a0123456789876543210 :: a0123456789876543210) = + Silly a0123456789876543210 instance SuppressUnusedWarnings Foo2Sym0 where suppressUnusedWarnings = snd (((,) Foo2Sym0KindInference) ()) data Foo2Sym0 :: forall a0123456789876543210 b0123456789876543210. @@ -397,9 +394,9 @@ Singletons/PatternMatching.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Foo2Sym0 arg) (Foo2Sym1 arg) => Foo2Sym0 a0123456789876543210 type instance Apply Foo2Sym0 a0123456789876543210 = Foo2Sym1 a0123456789876543210 - type Foo1Sym1 (a0123456789876543210 :: (a0123456789876543210, + type Foo2Sym1 (a0123456789876543210 :: (a0123456789876543210, b0123456789876543210)) = - Foo1 a0123456789876543210 + Foo2 a0123456789876543210 instance SuppressUnusedWarnings Foo1Sym0 where suppressUnusedWarnings = snd (((,) Foo1Sym0KindInference) ()) data Foo1Sym0 :: forall a0123456789876543210 b0123456789876543210. @@ -410,6 +407,9 @@ Singletons/PatternMatching.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Foo1Sym0 arg) (Foo1Sym1 arg) => Foo1Sym0 a0123456789876543210 type instance Apply Foo1Sym0 a0123456789876543210 = Foo1Sym1 a0123456789876543210 + type Foo1Sym1 (a0123456789876543210 :: (a0123456789876543210, + b0123456789876543210)) = + Foo1 a0123456789876543210 type BlimySym0 = Blimy type LszSym0 = Lsz type X_0123456789876543210Sym0 = X_0123456789876543210 diff --git a/tests/compile-and-dump/Singletons/PolyKinds.golden b/tests/compile-and-dump/Singletons/PolyKinds.golden index 3985b2b9..bb9d1031 100644 --- a/tests/compile-and-dump/Singletons/PolyKinds.golden +++ b/tests/compile-and-dump/Singletons/PolyKinds.golden @@ -5,8 +5,6 @@ Singletons/PolyKinds.hs:(0,0)-(0,0): Splicing declarations ======> class Cls (a :: k) where fff :: Proxy (a :: k) -> () - type FffSym1 (arg0123456789876543210 :: Proxy (a0123456789876543210 :: k0123456789876543210)) = - Fff arg0123456789876543210 instance SuppressUnusedWarnings FffSym0 where suppressUnusedWarnings = snd (((,) FffSym0KindInference) ()) data FffSym0 :: forall k0123456789876543210 @@ -17,6 +15,8 @@ Singletons/PolyKinds.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply FffSym0 arg) (FffSym1 arg) => FffSym0 arg0123456789876543210 type instance Apply FffSym0 arg0123456789876543210 = FffSym1 arg0123456789876543210 + type FffSym1 (arg0123456789876543210 :: Proxy (a0123456789876543210 :: k0123456789876543210)) = + Fff arg0123456789876543210 class PCls (a :: k) where type Fff (arg :: Proxy (a :: k)) :: () class SCls (a :: k) where diff --git a/tests/compile-and-dump/Singletons/Records.golden b/tests/compile-and-dump/Singletons/Records.golden index 523c8905..0542a359 100644 --- a/tests/compile-and-dump/Singletons/Records.golden +++ b/tests/compile-and-dump/Singletons/Records.golden @@ -3,8 +3,6 @@ Singletons/Records.hs:(0,0)-(0,0): Splicing declarations [d| data Record a = MkRecord {field1 :: a, field2 :: Bool} |] ======> data Record a = MkRecord {field1 :: a, field2 :: Bool} - type Field2Sym1 (a0123456789876543210 :: Record a0123456789876543210) = - Field2 a0123456789876543210 instance SuppressUnusedWarnings Field2Sym0 where suppressUnusedWarnings = snd (((,) Field2Sym0KindInference) ()) data Field2Sym0 :: forall a0123456789876543210. @@ -14,8 +12,8 @@ Singletons/Records.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Field2Sym0 arg) (Field2Sym1 arg) => Field2Sym0 a0123456789876543210 type instance Apply Field2Sym0 a0123456789876543210 = Field2Sym1 a0123456789876543210 - type Field1Sym1 (a0123456789876543210 :: Record a0123456789876543210) = - Field1 a0123456789876543210 + type Field2Sym1 (a0123456789876543210 :: Record a0123456789876543210) = + Field2 a0123456789876543210 instance SuppressUnusedWarnings Field1Sym0 where suppressUnusedWarnings = snd (((,) Field1Sym0KindInference) ()) data Field1Sym0 :: forall a0123456789876543210. @@ -25,21 +23,12 @@ Singletons/Records.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Field1Sym0 arg) (Field1Sym1 arg) => Field1Sym0 a0123456789876543210 type instance Apply Field1Sym0 a0123456789876543210 = Field1Sym1 a0123456789876543210 + type Field1Sym1 (a0123456789876543210 :: Record a0123456789876543210) = + Field1 a0123456789876543210 type family Field2 (a :: Record a) :: Bool where Field2 (MkRecord _ field) = field type family Field1 (a :: Record a) :: a where Field1 (MkRecord field _) = field - type MkRecordSym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: Bool) = - MkRecord t0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (MkRecordSym1 t0123456789876543210) where - suppressUnusedWarnings = snd (((,) MkRecordSym1KindInference) ()) - data MkRecordSym1 (t0123456789876543210 :: a0123456789876543210) :: (~>) Bool (Record a0123456789876543210) - where - MkRecordSym1KindInference :: forall t0123456789876543210 - t0123456789876543210 - arg. SameKind (Apply (MkRecordSym1 t0123456789876543210) arg) (MkRecordSym2 t0123456789876543210 arg) => - MkRecordSym1 t0123456789876543210 t0123456789876543210 - type instance Apply (MkRecordSym1 t0123456789876543210) t0123456789876543210 = MkRecordSym2 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings MkRecordSym0 where suppressUnusedWarnings = snd (((,) MkRecordSym0KindInference) ()) data MkRecordSym0 :: forall a0123456789876543210. @@ -49,6 +38,17 @@ Singletons/Records.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply MkRecordSym0 arg) (MkRecordSym1 arg) => MkRecordSym0 t0123456789876543210 type instance Apply MkRecordSym0 t0123456789876543210 = MkRecordSym1 t0123456789876543210 + instance SuppressUnusedWarnings (MkRecordSym1 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) MkRecordSym1KindInference) ()) + data MkRecordSym1 (t0123456789876543210 :: a0123456789876543210) :: (~>) Bool (Record a0123456789876543210) + where + MkRecordSym1KindInference :: forall t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (MkRecordSym1 t0123456789876543210) arg) (MkRecordSym2 t0123456789876543210 arg) => + MkRecordSym1 t0123456789876543210 t0123456789876543210 + type instance Apply (MkRecordSym1 t0123456789876543210) t0123456789876543210 = MkRecordSym2 t0123456789876543210 t0123456789876543210 + type MkRecordSym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: Bool) = + MkRecord t0123456789876543210 t0123456789876543210 data SRecord :: forall a. Record a -> GHC.Types.Type where SMkRecord :: forall a (n :: a) (n :: Bool). diff --git a/tests/compile-and-dump/Singletons/ReturnFunc.golden b/tests/compile-and-dump/Singletons/ReturnFunc.golden index 14fa2228..b7b29485 100644 --- a/tests/compile-and-dump/Singletons/ReturnFunc.golden +++ b/tests/compile-and-dump/Singletons/ReturnFunc.golden @@ -13,8 +13,15 @@ Singletons/ReturnFunc.hs:(0,0)-(0,0): Splicing declarations id x = x idFoo :: c -> a -> a idFoo _ = id - type IdFooSym2 (a0123456789876543210 :: c0123456789876543210) (a0123456789876543210 :: a0123456789876543210) = - IdFoo a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings IdFooSym0 where + suppressUnusedWarnings = snd (((,) IdFooSym0KindInference) ()) + data IdFooSym0 :: forall c0123456789876543210 a0123456789876543210. + (~>) c0123456789876543210 ((~>) a0123456789876543210 a0123456789876543210) + where + IdFooSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply IdFooSym0 arg) (IdFooSym1 arg) => + IdFooSym0 a0123456789876543210 + type instance Apply IdFooSym0 a0123456789876543210 = IdFooSym1 a0123456789876543210 instance SuppressUnusedWarnings (IdFooSym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) IdFooSym1KindInference) ()) data IdFooSym1 (a0123456789876543210 :: c0123456789876543210) :: forall a0123456789876543210. @@ -25,17 +32,8 @@ Singletons/ReturnFunc.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (IdFooSym1 a0123456789876543210) arg) (IdFooSym2 a0123456789876543210 arg) => IdFooSym1 a0123456789876543210 a0123456789876543210 type instance Apply (IdFooSym1 a0123456789876543210) a0123456789876543210 = IdFooSym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings IdFooSym0 where - suppressUnusedWarnings = snd (((,) IdFooSym0KindInference) ()) - data IdFooSym0 :: forall c0123456789876543210 a0123456789876543210. - (~>) c0123456789876543210 ((~>) a0123456789876543210 a0123456789876543210) - where - IdFooSym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply IdFooSym0 arg) (IdFooSym1 arg) => - IdFooSym0 a0123456789876543210 - type instance Apply IdFooSym0 a0123456789876543210 = IdFooSym1 a0123456789876543210 - type IdSym1 (a0123456789876543210 :: a0123456789876543210) = - Id a0123456789876543210 + type IdFooSym2 (a0123456789876543210 :: c0123456789876543210) (a0123456789876543210 :: a0123456789876543210) = + IdFoo a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings IdSym0 where suppressUnusedWarnings = snd (((,) IdSym0KindInference) ()) data IdSym0 :: forall a0123456789876543210. @@ -45,8 +43,16 @@ Singletons/ReturnFunc.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply IdSym0 arg) (IdSym1 arg) => IdSym0 a0123456789876543210 type instance Apply IdSym0 a0123456789876543210 = IdSym1 a0123456789876543210 - type ReturnFuncSym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) = - ReturnFunc a0123456789876543210 a0123456789876543210 + type IdSym1 (a0123456789876543210 :: a0123456789876543210) = + Id a0123456789876543210 + instance SuppressUnusedWarnings ReturnFuncSym0 where + suppressUnusedWarnings = snd (((,) ReturnFuncSym0KindInference) ()) + data ReturnFuncSym0 :: (~>) Nat ((~>) Nat Nat) + where + ReturnFuncSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply ReturnFuncSym0 arg) (ReturnFuncSym1 arg) => + ReturnFuncSym0 a0123456789876543210 + type instance Apply ReturnFuncSym0 a0123456789876543210 = ReturnFuncSym1 a0123456789876543210 instance SuppressUnusedWarnings (ReturnFuncSym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ReturnFuncSym1KindInference) ()) data ReturnFuncSym1 (a0123456789876543210 :: Nat) :: (~>) Nat Nat @@ -56,14 +62,8 @@ Singletons/ReturnFunc.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (ReturnFuncSym1 a0123456789876543210) arg) (ReturnFuncSym2 a0123456789876543210 arg) => ReturnFuncSym1 a0123456789876543210 a0123456789876543210 type instance Apply (ReturnFuncSym1 a0123456789876543210) a0123456789876543210 = ReturnFuncSym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ReturnFuncSym0 where - suppressUnusedWarnings = snd (((,) ReturnFuncSym0KindInference) ()) - data ReturnFuncSym0 :: (~>) Nat ((~>) Nat Nat) - where - ReturnFuncSym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply ReturnFuncSym0 arg) (ReturnFuncSym1 arg) => - ReturnFuncSym0 a0123456789876543210 - type instance Apply ReturnFuncSym0 a0123456789876543210 = ReturnFuncSym1 a0123456789876543210 + type ReturnFuncSym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) = + ReturnFunc a0123456789876543210 a0123456789876543210 type family IdFoo (a :: c) (a :: a) :: a where IdFoo _ a_0123456789876543210 = Apply IdSym0 a_0123456789876543210 type family Id (a :: a) :: a where diff --git a/tests/compile-and-dump/Singletons/Sections.golden b/tests/compile-and-dump/Singletons/Sections.golden index e4a80466..1a5fd838 100644 --- a/tests/compile-and-dump/Singletons/Sections.golden +++ b/tests/compile-and-dump/Singletons/Sections.golden @@ -21,8 +21,6 @@ Singletons/Sections.hs:(0,0)-(0,0): Splicing declarations foo3 = ((zipWith (+)) [Succ Zero, Succ Zero]) [Zero, Succ Zero] type family Lambda_0123456789876543210 t where Lambda_0123456789876543210 lhs_0123456789876543210 = Apply (Apply (+@#@$) lhs_0123456789876543210) (Apply SuccSym0 ZeroSym0) - type Lambda_0123456789876543210Sym1 t0123456789876543210 = - Lambda_0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) @@ -32,11 +30,19 @@ Singletons/Sections.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 t0123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 t0123456789876543210 = Lambda_0123456789876543210Sym1 t0123456789876543210 + type Lambda_0123456789876543210Sym1 t0123456789876543210 = + Lambda_0123456789876543210 t0123456789876543210 type Foo3Sym0 = Foo3 type Foo2Sym0 = Foo2 type Foo1Sym0 = Foo1 - type (+@#@$$$) (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) = - (+) a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (+@#@$) where + suppressUnusedWarnings = snd (((,) (:+@#@$###)) ()) + data (+@#@$) :: (~>) Nat ((~>) Nat Nat) + where + (:+@#@$###) :: forall a0123456789876543210 + arg. SameKind (Apply (+@#@$) arg) ((+@#@$$) arg) => + (+@#@$) a0123456789876543210 + type instance Apply (+@#@$) a0123456789876543210 = (+@#@$$) a0123456789876543210 instance SuppressUnusedWarnings ((+@#@$$) a0123456789876543210) where suppressUnusedWarnings = snd (((,) (:+@#@$$###)) ()) data (+@#@$$) (a0123456789876543210 :: Nat) :: (~>) Nat Nat @@ -46,14 +52,8 @@ Singletons/Sections.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply ((+@#@$$) a0123456789876543210) arg) ((+@#@$$$) a0123456789876543210 arg) => (+@#@$$) a0123456789876543210 a0123456789876543210 type instance Apply ((+@#@$$) a0123456789876543210) a0123456789876543210 = (+@#@$$$) a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (+@#@$) where - suppressUnusedWarnings = snd (((,) (:+@#@$###)) ()) - data (+@#@$) :: (~>) Nat ((~>) Nat Nat) - where - (:+@#@$###) :: forall a0123456789876543210 - arg. SameKind (Apply (+@#@$) arg) ((+@#@$$) arg) => - (+@#@$) a0123456789876543210 - type instance Apply (+@#@$) a0123456789876543210 = (+@#@$$) a0123456789876543210 + type (+@#@$$$) (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) = + (+) a0123456789876543210 a0123456789876543210 type family Foo3 :: [Nat] where Foo3 = Apply (Apply (Apply ZipWithSym0 (+@#@$)) (Apply (Apply (:@#@$) (Apply SuccSym0 ZeroSym0)) (Apply (Apply (:@#@$) (Apply SuccSym0 ZeroSym0)) '[]))) (Apply (Apply (:@#@$) ZeroSym0) (Apply (Apply (:@#@$) (Apply SuccSym0 ZeroSym0)) '[])) type family Foo2 :: [Nat] where diff --git a/tests/compile-and-dump/Singletons/ShowDeriving.golden b/tests/compile-and-dump/Singletons/ShowDeriving.golden index 4bfea3c9..9ced7059 100644 --- a/tests/compile-and-dump/Singletons/ShowDeriving.golden +++ b/tests/compile-and-dump/Singletons/ShowDeriving.golden @@ -24,8 +24,6 @@ Singletons/ShowDeriving.hs:(0,0)-(0,0): Splicing declarations data Foo3 = MkFoo3 {getFoo3a :: Bool, *** :: Bool} deriving Show - type (***@#@$$) (a0123456789876543210 :: Foo3) = - (***) a0123456789876543210 instance SuppressUnusedWarnings (***@#@$) where suppressUnusedWarnings = snd (((,) (:***@#@$###)) ()) data (***@#@$) :: (~>) Foo3 Bool @@ -34,8 +32,8 @@ Singletons/ShowDeriving.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (***@#@$) arg) ((***@#@$$) arg) => (***@#@$) a0123456789876543210 type instance Apply (***@#@$) a0123456789876543210 = (***@#@$$) a0123456789876543210 - type GetFoo3aSym1 (a0123456789876543210 :: Foo3) = - GetFoo3a a0123456789876543210 + type (***@#@$$) (a0123456789876543210 :: Foo3) = + (***) a0123456789876543210 instance SuppressUnusedWarnings GetFoo3aSym0 where suppressUnusedWarnings = snd (((,) GetFoo3aSym0KindInference) ()) data GetFoo3aSym0 :: (~>) Foo3 Bool @@ -44,13 +42,22 @@ Singletons/ShowDeriving.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply GetFoo3aSym0 arg) (GetFoo3aSym1 arg) => GetFoo3aSym0 a0123456789876543210 type instance Apply GetFoo3aSym0 a0123456789876543210 = GetFoo3aSym1 a0123456789876543210 + type GetFoo3aSym1 (a0123456789876543210 :: Foo3) = + GetFoo3a a0123456789876543210 type family (***) (a :: Foo3) :: Bool where (***) (MkFoo3 _ field) = field type family GetFoo3a (a :: Foo3) :: Bool where GetFoo3a (MkFoo3 field _) = field type MkFoo1Sym0 = MkFoo1 - type MkFoo2aSym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: a0123456789876543210) = - MkFoo2a t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings MkFoo2aSym0 where + suppressUnusedWarnings = snd (((,) MkFoo2aSym0KindInference) ()) + data MkFoo2aSym0 :: forall a0123456789876543210. + (~>) a0123456789876543210 ((~>) a0123456789876543210 (Foo2 a0123456789876543210)) + where + MkFoo2aSym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply MkFoo2aSym0 arg) (MkFoo2aSym1 arg) => + MkFoo2aSym0 t0123456789876543210 + type instance Apply MkFoo2aSym0 t0123456789876543210 = MkFoo2aSym1 t0123456789876543210 instance SuppressUnusedWarnings (MkFoo2aSym1 t0123456789876543210) where suppressUnusedWarnings = snd (((,) MkFoo2aSym1KindInference) ()) data MkFoo2aSym1 (t0123456789876543210 :: a0123456789876543210) :: (~>) a0123456789876543210 (Foo2 a0123456789876543210) @@ -60,18 +67,18 @@ Singletons/ShowDeriving.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (MkFoo2aSym1 t0123456789876543210) arg) (MkFoo2aSym2 t0123456789876543210 arg) => MkFoo2aSym1 t0123456789876543210 t0123456789876543210 type instance Apply (MkFoo2aSym1 t0123456789876543210) t0123456789876543210 = MkFoo2aSym2 t0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings MkFoo2aSym0 where - suppressUnusedWarnings = snd (((,) MkFoo2aSym0KindInference) ()) - data MkFoo2aSym0 :: forall a0123456789876543210. + type MkFoo2aSym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: a0123456789876543210) = + MkFoo2a t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings MkFoo2bSym0 where + suppressUnusedWarnings = snd (((,) MkFoo2bSym0KindInference) ()) + data MkFoo2bSym0 :: forall a0123456789876543210. (~>) a0123456789876543210 ((~>) a0123456789876543210 (Foo2 a0123456789876543210)) where - MkFoo2aSym0KindInference :: forall t0123456789876543210 - arg. SameKind (Apply MkFoo2aSym0 arg) (MkFoo2aSym1 arg) => - MkFoo2aSym0 t0123456789876543210 - type instance Apply MkFoo2aSym0 t0123456789876543210 = MkFoo2aSym1 t0123456789876543210 - type MkFoo2bSym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: a0123456789876543210) = - MkFoo2b t0123456789876543210 t0123456789876543210 - infixl 5 `MkFoo2bSym2` + MkFoo2bSym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply MkFoo2bSym0 arg) (MkFoo2bSym1 arg) => + MkFoo2bSym0 t0123456789876543210 + type instance Apply MkFoo2bSym0 t0123456789876543210 = MkFoo2bSym1 t0123456789876543210 + infixl 5 `MkFoo2bSym0` instance SuppressUnusedWarnings (MkFoo2bSym1 t0123456789876543210) where suppressUnusedWarnings = snd (((,) MkFoo2bSym1KindInference) ()) data MkFoo2bSym1 (t0123456789876543210 :: a0123456789876543210) :: (~>) a0123456789876543210 (Foo2 a0123456789876543210) @@ -82,19 +89,19 @@ Singletons/ShowDeriving.hs:(0,0)-(0,0): Splicing declarations MkFoo2bSym1 t0123456789876543210 t0123456789876543210 type instance Apply (MkFoo2bSym1 t0123456789876543210) t0123456789876543210 = MkFoo2bSym2 t0123456789876543210 t0123456789876543210 infixl 5 `MkFoo2bSym1` - instance SuppressUnusedWarnings MkFoo2bSym0 where - suppressUnusedWarnings = snd (((,) MkFoo2bSym0KindInference) ()) - data MkFoo2bSym0 :: forall a0123456789876543210. - (~>) a0123456789876543210 ((~>) a0123456789876543210 (Foo2 a0123456789876543210)) + type MkFoo2bSym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: a0123456789876543210) = + MkFoo2b t0123456789876543210 t0123456789876543210 + infixl 5 `MkFoo2bSym2` + instance SuppressUnusedWarnings (:*:@#@$) where + suppressUnusedWarnings = snd (((,) (::*:@#@$###)) ()) + data (:*:@#@$) :: forall a0123456789876543210. + (~>) a0123456789876543210 ((~>) a0123456789876543210 (Foo2 a0123456789876543210)) where - MkFoo2bSym0KindInference :: forall t0123456789876543210 - arg. SameKind (Apply MkFoo2bSym0 arg) (MkFoo2bSym1 arg) => - MkFoo2bSym0 t0123456789876543210 - type instance Apply MkFoo2bSym0 t0123456789876543210 = MkFoo2bSym1 t0123456789876543210 - infixl 5 `MkFoo2bSym0` - type (:*:@#@$$$) (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: a0123456789876543210) = - (:*:) t0123456789876543210 t0123456789876543210 - infixl 5 :*:@#@$$$ + (::*:@#@$###) :: forall t0123456789876543210 + arg. SameKind (Apply (:*:@#@$) arg) ((:*:@#@$$) arg) => + (:*:@#@$) t0123456789876543210 + type instance Apply (:*:@#@$) t0123456789876543210 = (:*:@#@$$) t0123456789876543210 + infixl 5 :*:@#@$ instance SuppressUnusedWarnings ((:*:@#@$$) t0123456789876543210) where suppressUnusedWarnings = snd (((,) (::*:@#@$$###)) ()) data (:*:@#@$$) (t0123456789876543210 :: a0123456789876543210) :: (~>) a0123456789876543210 (Foo2 a0123456789876543210) @@ -105,19 +112,19 @@ Singletons/ShowDeriving.hs:(0,0)-(0,0): Splicing declarations (:*:@#@$$) t0123456789876543210 t0123456789876543210 type instance Apply ((:*:@#@$$) t0123456789876543210) t0123456789876543210 = (:*:@#@$$$) t0123456789876543210 t0123456789876543210 infixl 5 :*:@#@$$ - instance SuppressUnusedWarnings (:*:@#@$) where - suppressUnusedWarnings = snd (((,) (::*:@#@$###)) ()) - data (:*:@#@$) :: forall a0123456789876543210. + type (:*:@#@$$$) (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: a0123456789876543210) = + (:*:) t0123456789876543210 t0123456789876543210 + infixl 5 :*:@#@$$$ + instance SuppressUnusedWarnings (:&:@#@$) where + suppressUnusedWarnings = snd (((,) (::&:@#@$###)) ()) + data (:&:@#@$) :: forall a0123456789876543210. (~>) a0123456789876543210 ((~>) a0123456789876543210 (Foo2 a0123456789876543210)) where - (::*:@#@$###) :: forall t0123456789876543210 - arg. SameKind (Apply (:*:@#@$) arg) ((:*:@#@$$) arg) => - (:*:@#@$) t0123456789876543210 - type instance Apply (:*:@#@$) t0123456789876543210 = (:*:@#@$$) t0123456789876543210 - infixl 5 :*:@#@$ - type (:&:@#@$$$) (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: a0123456789876543210) = - (:&:) t0123456789876543210 t0123456789876543210 - infixl 5 :&:@#@$$$ + (::&:@#@$###) :: forall t0123456789876543210 + arg. SameKind (Apply (:&:@#@$) arg) ((:&:@#@$$) arg) => + (:&:@#@$) t0123456789876543210 + type instance Apply (:&:@#@$) t0123456789876543210 = (:&:@#@$$) t0123456789876543210 + infixl 5 :&:@#@$ instance SuppressUnusedWarnings ((:&:@#@$$) t0123456789876543210) where suppressUnusedWarnings = snd (((,) (::&:@#@$$###)) ()) data (:&:@#@$$) (t0123456789876543210 :: a0123456789876543210) :: (~>) a0123456789876543210 (Foo2 a0123456789876543210) @@ -128,18 +135,17 @@ Singletons/ShowDeriving.hs:(0,0)-(0,0): Splicing declarations (:&:@#@$$) t0123456789876543210 t0123456789876543210 type instance Apply ((:&:@#@$$) t0123456789876543210) t0123456789876543210 = (:&:@#@$$$) t0123456789876543210 t0123456789876543210 infixl 5 :&:@#@$$ - instance SuppressUnusedWarnings (:&:@#@$) where - suppressUnusedWarnings = snd (((,) (::&:@#@$###)) ()) - data (:&:@#@$) :: forall a0123456789876543210. - (~>) a0123456789876543210 ((~>) a0123456789876543210 (Foo2 a0123456789876543210)) + type (:&:@#@$$$) (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: a0123456789876543210) = + (:&:) t0123456789876543210 t0123456789876543210 + infixl 5 :&:@#@$$$ + instance SuppressUnusedWarnings MkFoo3Sym0 where + suppressUnusedWarnings = snd (((,) MkFoo3Sym0KindInference) ()) + data MkFoo3Sym0 :: (~>) Bool ((~>) Bool Foo3) where - (::&:@#@$###) :: forall t0123456789876543210 - arg. SameKind (Apply (:&:@#@$) arg) ((:&:@#@$$) arg) => - (:&:@#@$) t0123456789876543210 - type instance Apply (:&:@#@$) t0123456789876543210 = (:&:@#@$$) t0123456789876543210 - infixl 5 :&:@#@$ - type MkFoo3Sym2 (t0123456789876543210 :: Bool) (t0123456789876543210 :: Bool) = - MkFoo3 t0123456789876543210 t0123456789876543210 + MkFoo3Sym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply MkFoo3Sym0 arg) (MkFoo3Sym1 arg) => + MkFoo3Sym0 t0123456789876543210 + type instance Apply MkFoo3Sym0 t0123456789876543210 = MkFoo3Sym1 t0123456789876543210 instance SuppressUnusedWarnings (MkFoo3Sym1 t0123456789876543210) where suppressUnusedWarnings = snd (((,) MkFoo3Sym1KindInference) ()) data MkFoo3Sym1 (t0123456789876543210 :: Bool) :: (~>) Bool Foo3 @@ -149,29 +155,19 @@ Singletons/ShowDeriving.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (MkFoo3Sym1 t0123456789876543210) arg) (MkFoo3Sym2 t0123456789876543210 arg) => MkFoo3Sym1 t0123456789876543210 t0123456789876543210 type instance Apply (MkFoo3Sym1 t0123456789876543210) t0123456789876543210 = MkFoo3Sym2 t0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings MkFoo3Sym0 where - suppressUnusedWarnings = snd (((,) MkFoo3Sym0KindInference) ()) - data MkFoo3Sym0 :: (~>) Bool ((~>) Bool Foo3) - where - MkFoo3Sym0KindInference :: forall t0123456789876543210 - arg. SameKind (Apply MkFoo3Sym0 arg) (MkFoo3Sym1 arg) => - MkFoo3Sym0 t0123456789876543210 - type instance Apply MkFoo3Sym0 t0123456789876543210 = MkFoo3Sym1 t0123456789876543210 + type MkFoo3Sym2 (t0123456789876543210 :: Bool) (t0123456789876543210 :: Bool) = + MkFoo3 t0123456789876543210 t0123456789876543210 type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Foo1) (a :: Symbol) :: Symbol where ShowsPrec_0123456789876543210 _ MkFoo1 a_0123456789876543210 = Apply (Apply ShowStringSym0 "MkFoo1") a_0123456789876543210 - type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Foo1) (a0123456789876543210 :: Symbol) = - ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where suppressUnusedWarnings - = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) - data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Foo1) :: (~>) Symbol Symbol + = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) + data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Types.Nat ((~>) Foo1 ((~>) Symbol Symbol)) where - ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 - a0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => - ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 - type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 + ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => + ShowsPrec_0123456789876543210Sym0 a0123456789876543210 + type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ()) @@ -182,15 +178,19 @@ Singletons/ShowDeriving.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) => ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where + instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where suppressUnusedWarnings - = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) - data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Types.Nat ((~>) Foo1 ((~>) Symbol Symbol)) + = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) + data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Foo1) :: (~>) Symbol Symbol where - ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => - ShowsPrec_0123456789876543210Sym0 a0123456789876543210 - type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 + ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 + a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => + ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Foo1) (a0123456789876543210 :: Symbol) = + ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance PShow Foo1 where type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Foo2 a) (a :: Symbol) :: Symbol where @@ -198,19 +198,16 @@ Singletons/ShowDeriving.hs:(0,0)-(0,0): Splicing declarations ShowsPrec_0123456789876543210 p_0123456789876543210 (MkFoo2b argL_0123456789876543210 argR_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 5))) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 6)) argL_0123456789876543210)) (Apply (Apply (.@#@$) (Apply ShowStringSym0 " `MkFoo2b` ")) (Apply (Apply ShowsPrecSym0 (FromInteger 6)) argR_0123456789876543210)))) a_0123456789876543210 ShowsPrec_0123456789876543210 p_0123456789876543210 ((:*:) arg_0123456789876543210 arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "(:*:) ")) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210)) (Apply (Apply (.@#@$) ShowSpaceSym0) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210))))) a_0123456789876543210 ShowsPrec_0123456789876543210 p_0123456789876543210 ((:&:) argL_0123456789876543210 argR_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 5))) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 6)) argL_0123456789876543210)) (Apply (Apply (.@#@$) (Apply ShowStringSym0 " :&: ")) (Apply (Apply ShowsPrecSym0 (FromInteger 6)) argR_0123456789876543210)))) a_0123456789876543210 - type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Foo2 a0123456789876543210) (a0123456789876543210 :: Symbol) = - ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where suppressUnusedWarnings - = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) - data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Foo2 a0123456789876543210) :: (~>) Symbol Symbol + = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) + data ShowsPrec_0123456789876543210Sym0 :: forall a0123456789876543210. + (~>) GHC.Types.Nat ((~>) (Foo2 a0123456789876543210) ((~>) Symbol Symbol)) where - ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 - a0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => - ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 - type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 + ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => + ShowsPrec_0123456789876543210Sym0 a0123456789876543210 + type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ()) @@ -222,26 +219,10 @@ Singletons/ShowDeriving.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) => ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) - data ShowsPrec_0123456789876543210Sym0 :: forall a0123456789876543210. - (~>) GHC.Types.Nat ((~>) (Foo2 a0123456789876543210) ((~>) Symbol Symbol)) - where - ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => - ShowsPrec_0123456789876543210Sym0 a0123456789876543210 - type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 - instance PShow (Foo2 a) where - type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a - type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Foo3) (a :: Symbol) :: Symbol where - ShowsPrec_0123456789876543210 p_0123456789876543210 (MkFoo3 arg_0123456789876543210 arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "MkFoo3 ")) (Apply (Apply (.@#@$) (Apply ShowCharSym0 "{")) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "getFoo3a = ")) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 0)) arg_0123456789876543210)) (Apply (Apply (.@#@$) ShowCommaSpaceSym0) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "(***) = ")) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 0)) arg_0123456789876543210)) (Apply ShowCharSym0 "}"))))))))) a_0123456789876543210 - type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Foo3) (a0123456789876543210 :: Symbol) = - ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) - data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Foo3) :: (~>) Symbol Symbol + data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Foo2 a0123456789876543210) :: (~>) Symbol Symbol where ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 a0123456789876543210 @@ -249,6 +230,21 @@ Singletons/ShowDeriving.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Foo2 a0123456789876543210) (a0123456789876543210 :: Symbol) = + ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 + instance PShow (Foo2 a) where + type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a + type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Foo3) (a :: Symbol) :: Symbol where + ShowsPrec_0123456789876543210 p_0123456789876543210 (MkFoo3 arg_0123456789876543210 arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "MkFoo3 ")) (Apply (Apply (.@#@$) (Apply ShowCharSym0 "{")) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "getFoo3a = ")) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 0)) arg_0123456789876543210)) (Apply (Apply (.@#@$) ShowCommaSpaceSym0) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "(***) = ")) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 0)) arg_0123456789876543210)) (Apply ShowCharSym0 "}"))))))))) a_0123456789876543210 + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) + data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Types.Nat ((~>) Foo3 ((~>) Symbol Symbol)) + where + ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => + ShowsPrec_0123456789876543210Sym0 a0123456789876543210 + type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ()) @@ -259,15 +255,19 @@ Singletons/ShowDeriving.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) => ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where + instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where suppressUnusedWarnings - = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) - data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Types.Nat ((~>) Foo3 ((~>) Symbol Symbol)) + = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) + data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Foo3) :: (~>) Symbol Symbol where - ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => - ShowsPrec_0123456789876543210Sym0 a0123456789876543210 - type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 + ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 + a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => + ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Foo3) (a0123456789876543210 :: Symbol) = + ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance PShow Foo3 where type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a infixl 5 :%&: diff --git a/tests/compile-and-dump/Singletons/StandaloneDeriving.golden b/tests/compile-and-dump/Singletons/StandaloneDeriving.golden index c8fd30c0..33e7089f 100644 --- a/tests/compile-and-dump/Singletons/StandaloneDeriving.golden +++ b/tests/compile-and-dump/Singletons/StandaloneDeriving.golden @@ -25,9 +25,16 @@ Singletons/StandaloneDeriving.hs:(0,0)-(0,0): Splicing declarations deriving instance Show S deriving instance Bounded S deriving instance Enum S - type (:*:@#@$$$) (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) = - (:*:) t0123456789876543210 t0123456789876543210 - infixl 6 :*:@#@$$$ + instance SuppressUnusedWarnings (:*:@#@$) where + suppressUnusedWarnings = snd (((,) (::*:@#@$###)) ()) + data (:*:@#@$) :: forall a0123456789876543210 b0123456789876543210. + (~>) a0123456789876543210 ((~>) b0123456789876543210 (T a0123456789876543210 b0123456789876543210)) + where + (::*:@#@$###) :: forall t0123456789876543210 + arg. SameKind (Apply (:*:@#@$) arg) ((:*:@#@$$) arg) => + (:*:@#@$) t0123456789876543210 + type instance Apply (:*:@#@$) t0123456789876543210 = (:*:@#@$$) t0123456789876543210 + infixl 6 :*:@#@$ instance SuppressUnusedWarnings ((:*:@#@$$) t0123456789876543210) where suppressUnusedWarnings = snd (((,) (::*:@#@$$###)) ()) data (:*:@#@$$) (t0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. @@ -39,32 +46,13 @@ Singletons/StandaloneDeriving.hs:(0,0)-(0,0): Splicing declarations (:*:@#@$$) t0123456789876543210 t0123456789876543210 type instance Apply ((:*:@#@$$) t0123456789876543210) t0123456789876543210 = (:*:@#@$$$) t0123456789876543210 t0123456789876543210 infixl 6 :*:@#@$$ - instance SuppressUnusedWarnings (:*:@#@$) where - suppressUnusedWarnings = snd (((,) (::*:@#@$###)) ()) - data (:*:@#@$) :: forall a0123456789876543210 b0123456789876543210. - (~>) a0123456789876543210 ((~>) b0123456789876543210 (T a0123456789876543210 b0123456789876543210)) - where - (::*:@#@$###) :: forall t0123456789876543210 - arg. SameKind (Apply (:*:@#@$) arg) ((:*:@#@$$) arg) => - (:*:@#@$) t0123456789876543210 - type instance Apply (:*:@#@$) t0123456789876543210 = (:*:@#@$$) t0123456789876543210 - infixl 6 :*:@#@$ + type (:*:@#@$$$) (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) = + (:*:) t0123456789876543210 t0123456789876543210 + infixl 6 :*:@#@$$$ type S1Sym0 = S1 type S2Sym0 = S2 type family Compare_0123456789876543210 (a :: T a ()) (a :: T a ()) :: Ordering where Compare_0123456789876543210 ((:*:) a_0123456789876543210 a_0123456789876543210) ((:*:) b_0123456789876543210 b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[])) - type Compare_0123456789876543210Sym2 (a0123456789876543210 :: T a0123456789876543210 ()) (a0123456789876543210 :: T a0123456789876543210 ()) = - Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (Compare_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd (((,) Compare_0123456789876543210Sym1KindInference) ()) - data Compare_0123456789876543210Sym1 (a0123456789876543210 :: T a0123456789876543210 ()) :: (~>) (T a0123456789876543210 ()) Ordering - where - Compare_0123456789876543210Sym1KindInference :: forall a0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply (Compare_0123456789876543210Sym1 a0123456789876543210) arg) (Compare_0123456789876543210Sym2 a0123456789876543210 arg) => - Compare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 - type instance Apply (Compare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Compare_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Compare_0123456789876543210Sym0KindInference) ()) @@ -75,23 +63,32 @@ Singletons/StandaloneDeriving.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => Compare_0123456789876543210Sym0 a0123456789876543210 type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 + instance SuppressUnusedWarnings (Compare_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Compare_0123456789876543210Sym1KindInference) ()) + data Compare_0123456789876543210Sym1 (a0123456789876543210 :: T a0123456789876543210 ()) :: (~>) (T a0123456789876543210 ()) Ordering + where + Compare_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Compare_0123456789876543210Sym1 a0123456789876543210) arg) (Compare_0123456789876543210Sym2 a0123456789876543210 arg) => + Compare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Compare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Compare_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 + type Compare_0123456789876543210Sym2 (a0123456789876543210 :: T a0123456789876543210 ()) (a0123456789876543210 :: T a0123456789876543210 ()) = + Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance POrd (T a ()) where type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: T a ()) (a :: Symbol) :: Symbol where ShowsPrec_0123456789876543210 p_0123456789876543210 ((:*:) argL_0123456789876543210 argR_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 6))) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 7)) argL_0123456789876543210)) (Apply (Apply (.@#@$) (Apply ShowStringSym0 " :*: ")) (Apply (Apply ShowsPrecSym0 (FromInteger 7)) argR_0123456789876543210)))) a_0123456789876543210 - type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: T a0123456789876543210 ()) (a0123456789876543210 :: Symbol) = - ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where suppressUnusedWarnings - = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) - data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: T a0123456789876543210 ()) :: (~>) Symbol Symbol + = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) + data ShowsPrec_0123456789876543210Sym0 :: forall a0123456789876543210. + (~>) GHC.Types.Nat ((~>) (T a0123456789876543210 ()) ((~>) Symbol Symbol)) where - ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 - a0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => - ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 - type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 + ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => + ShowsPrec_0123456789876543210Sym0 a0123456789876543210 + type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ()) @@ -103,16 +100,19 @@ Singletons/StandaloneDeriving.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) => ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where + instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where suppressUnusedWarnings - = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) - data ShowsPrec_0123456789876543210Sym0 :: forall a0123456789876543210. - (~>) GHC.Types.Nat ((~>) (T a0123456789876543210 ()) ((~>) Symbol Symbol)) + = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) + data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: T a0123456789876543210 ()) :: (~>) Symbol Symbol where - ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => - ShowsPrec_0123456789876543210Sym0 a0123456789876543210 - type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 + ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 + a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => + ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: T a0123456789876543210 ()) (a0123456789876543210 :: Symbol) = + ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance PShow (T a ()) where type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a type family Compare_0123456789876543210 (a :: S) (a :: S) :: Ordering where @@ -120,8 +120,15 @@ Singletons/StandaloneDeriving.hs:(0,0)-(0,0): Splicing declarations Compare_0123456789876543210 S2 S2 = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] Compare_0123456789876543210 S1 S2 = LTSym0 Compare_0123456789876543210 S2 S1 = GTSym0 - type Compare_0123456789876543210Sym2 (a0123456789876543210 :: S) (a0123456789876543210 :: S) = - Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Compare_0123456789876543210Sym0KindInference) ()) + data Compare_0123456789876543210Sym0 :: (~>) S ((~>) S Ordering) + where + Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => + Compare_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 instance SuppressUnusedWarnings (Compare_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Compare_0123456789876543210Sym1KindInference) ()) @@ -132,33 +139,22 @@ Singletons/StandaloneDeriving.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Compare_0123456789876543210Sym1 a0123456789876543210) arg) (Compare_0123456789876543210Sym2 a0123456789876543210 arg) => Compare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Compare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Compare_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd (((,) Compare_0123456789876543210Sym0KindInference) ()) - data Compare_0123456789876543210Sym0 :: (~>) S ((~>) S Ordering) - where - Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => - Compare_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 + type Compare_0123456789876543210Sym2 (a0123456789876543210 :: S) (a0123456789876543210 :: S) = + Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance POrd S where type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: S) (a :: Symbol) :: Symbol where ShowsPrec_0123456789876543210 _ S1 a_0123456789876543210 = Apply (Apply ShowStringSym0 "S1") a_0123456789876543210 ShowsPrec_0123456789876543210 _ S2 a_0123456789876543210 = Apply (Apply ShowStringSym0 "S2") a_0123456789876543210 - type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: S) (a0123456789876543210 :: Symbol) = - ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where suppressUnusedWarnings - = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) - data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: S) :: (~>) Symbol Symbol + = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) + data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Types.Nat ((~>) S ((~>) Symbol Symbol)) where - ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 - a0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => - ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 - type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 + ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => + ShowsPrec_0123456789876543210Sym0 a0123456789876543210 + type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ()) @@ -169,15 +165,19 @@ Singletons/StandaloneDeriving.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) => ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where + instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where suppressUnusedWarnings - = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) - data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Types.Nat ((~>) S ((~>) Symbol Symbol)) + = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) + data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: S) :: (~>) Symbol Symbol where - ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => - ShowsPrec_0123456789876543210Sym0 a0123456789876543210 - type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 + ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 + a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => + ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: S) (a0123456789876543210 :: Symbol) = + ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance PShow S where type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a type family MinBound_0123456789876543210 :: S where @@ -199,8 +199,6 @@ Singletons/StandaloneDeriving.hs:(0,0)-(0,0): Splicing declarations Case_0123456789876543210 n 'False = Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (FromInteger 1)) type family ToEnum_0123456789876543210 (a :: GHC.Types.Nat) :: S where ToEnum_0123456789876543210 n = Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (FromInteger 0)) - type ToEnum_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) = - ToEnum_0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings ToEnum_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) ToEnum_0123456789876543210Sym0KindInference) ()) @@ -210,11 +208,11 @@ Singletons/StandaloneDeriving.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply ToEnum_0123456789876543210Sym0 arg) (ToEnum_0123456789876543210Sym1 arg) => ToEnum_0123456789876543210Sym0 a0123456789876543210 type instance Apply ToEnum_0123456789876543210Sym0 a0123456789876543210 = ToEnum_0123456789876543210Sym1 a0123456789876543210 + type ToEnum_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) = + ToEnum_0123456789876543210 a0123456789876543210 type family FromEnum_0123456789876543210 (a :: S) :: GHC.Types.Nat where FromEnum_0123456789876543210 S1 = FromInteger 0 FromEnum_0123456789876543210 S2 = FromInteger 1 - type FromEnum_0123456789876543210Sym1 (a0123456789876543210 :: S) = - FromEnum_0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings FromEnum_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) FromEnum_0123456789876543210Sym0KindInference) ()) @@ -224,6 +222,8 @@ Singletons/StandaloneDeriving.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply FromEnum_0123456789876543210Sym0 arg) (FromEnum_0123456789876543210Sym1 arg) => FromEnum_0123456789876543210Sym0 a0123456789876543210 type instance Apply FromEnum_0123456789876543210Sym0 a0123456789876543210 = FromEnum_0123456789876543210Sym1 a0123456789876543210 + type FromEnum_0123456789876543210Sym1 (a0123456789876543210 :: S) = + FromEnum_0123456789876543210 a0123456789876543210 instance PEnum S where type ToEnum a = Apply ToEnum_0123456789876543210Sym0 a type FromEnum a = Apply FromEnum_0123456789876543210Sym0 a diff --git a/tests/compile-and-dump/Singletons/Star.golden b/tests/compile-and-dump/Singletons/Star.golden index 12f670d6..4dd7b0c0 100644 --- a/tests/compile-and-dump/Singletons/Star.golden +++ b/tests/compile-and-dump/Singletons/Star.golden @@ -12,8 +12,6 @@ Singletons/Star.hs:0:0:: Splicing declarations type NatSym0 = Nat type IntSym0 = Int type StringSym0 = String - type MaybeSym1 (t0123456789876543210 :: Type) = - Maybe t0123456789876543210 instance SuppressUnusedWarnings MaybeSym0 where suppressUnusedWarnings = snd (((,) MaybeSym0KindInference) ()) data MaybeSym0 :: (~>) Type Type @@ -22,8 +20,16 @@ Singletons/Star.hs:0:0:: Splicing declarations arg. SameKind (Apply MaybeSym0 arg) (MaybeSym1 arg) => MaybeSym0 t0123456789876543210 type instance Apply MaybeSym0 t0123456789876543210 = MaybeSym1 t0123456789876543210 - type VecSym2 (t0123456789876543210 :: Type) (t0123456789876543210 :: Nat) = - Vec t0123456789876543210 t0123456789876543210 + type MaybeSym1 (t0123456789876543210 :: Type) = + Maybe t0123456789876543210 + instance SuppressUnusedWarnings VecSym0 where + suppressUnusedWarnings = snd (((,) VecSym0KindInference) ()) + data VecSym0 :: (~>) Type ((~>) Nat Type) + where + VecSym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply VecSym0 arg) (VecSym1 arg) => + VecSym0 t0123456789876543210 + type instance Apply VecSym0 t0123456789876543210 = VecSym1 t0123456789876543210 instance SuppressUnusedWarnings (VecSym1 t0123456789876543210) where suppressUnusedWarnings = snd (((,) VecSym1KindInference) ()) data VecSym1 (t0123456789876543210 :: Type) :: (~>) Nat Type @@ -33,14 +39,8 @@ Singletons/Star.hs:0:0:: Splicing declarations arg. SameKind (Apply (VecSym1 t0123456789876543210) arg) (VecSym2 t0123456789876543210 arg) => VecSym1 t0123456789876543210 t0123456789876543210 type instance Apply (VecSym1 t0123456789876543210) t0123456789876543210 = VecSym2 t0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings VecSym0 where - suppressUnusedWarnings = snd (((,) VecSym0KindInference) ()) - data VecSym0 :: (~>) Type ((~>) Nat Type) - where - VecSym0KindInference :: forall t0123456789876543210 - arg. SameKind (Apply VecSym0 arg) (VecSym1 arg) => - VecSym0 t0123456789876543210 - type instance Apply VecSym0 t0123456789876543210 = VecSym1 t0123456789876543210 + type VecSym2 (t0123456789876543210 :: Type) (t0123456789876543210 :: Nat) = + Vec t0123456789876543210 t0123456789876543210 type family Equals_0123456789876543210 (a :: Type) (b :: Type) :: Bool where Equals_0123456789876543210 Nat Nat = TrueSym0 Equals_0123456789876543210 Int Int = TrueSym0 @@ -76,8 +76,15 @@ Singletons/Star.hs:0:0:: Splicing declarations Compare_0123456789876543210 (Vec _ _) Int = GTSym0 Compare_0123456789876543210 (Vec _ _) String = GTSym0 Compare_0123456789876543210 (Vec _ _) (Maybe _) = GTSym0 - type Compare_0123456789876543210Sym2 (a0123456789876543210 :: Type) (a0123456789876543210 :: Type) = - Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Compare_0123456789876543210Sym0KindInference) ()) + data Compare_0123456789876543210Sym0 :: (~>) Type ((~>) Type Ordering) + where + Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => + Compare_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 instance SuppressUnusedWarnings (Compare_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Compare_0123456789876543210Sym1KindInference) ()) @@ -88,15 +95,8 @@ Singletons/Star.hs:0:0:: Splicing declarations arg. SameKind (Apply (Compare_0123456789876543210Sym1 a0123456789876543210) arg) (Compare_0123456789876543210Sym2 a0123456789876543210 arg) => Compare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Compare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Compare_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd (((,) Compare_0123456789876543210Sym0KindInference) ()) - data Compare_0123456789876543210Sym0 :: (~>) Type ((~>) Type Ordering) - where - Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => - Compare_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 + type Compare_0123456789876543210Sym2 (a0123456789876543210 :: Type) (a0123456789876543210 :: Type) = + Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance POrd Type where type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Type) (a :: Symbol) :: Symbol where @@ -105,19 +105,15 @@ Singletons/Star.hs:0:0:: Splicing declarations ShowsPrec_0123456789876543210 _ String a_0123456789876543210 = Apply (Apply ShowStringSym0 "String") a_0123456789876543210 ShowsPrec_0123456789876543210 p_0123456789876543210 (Maybe arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "Maybe ")) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210))) a_0123456789876543210 ShowsPrec_0123456789876543210 p_0123456789876543210 (Vec arg_0123456789876543210 arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "Vec ")) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210)) (Apply (Apply (.@#@$) ShowSpaceSym0) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210))))) a_0123456789876543210 - type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Type) (a0123456789876543210 :: Symbol) = - ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where suppressUnusedWarnings - = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) - data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Type) :: (~>) Symbol Symbol + = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) + data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Types.Nat ((~>) Type ((~>) Symbol Symbol)) where - ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 - a0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => - ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 - type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 + ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => + ShowsPrec_0123456789876543210Sym0 a0123456789876543210 + type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ()) @@ -128,15 +124,19 @@ Singletons/Star.hs:0:0:: Splicing declarations arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) => ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where + instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where suppressUnusedWarnings - = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) - data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Types.Nat ((~>) Type ((~>) Symbol Symbol)) + = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) + data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Type) :: (~>) Symbol Symbol where - ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => - ShowsPrec_0123456789876543210Sym0 a0123456789876543210 - type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 + ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 + a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => + ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Type) (a0123456789876543210 :: Symbol) = + ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance PShow Type where type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a data SRep :: Type -> Type diff --git a/tests/compile-and-dump/Singletons/T124.golden b/tests/compile-and-dump/Singletons/T124.golden index 43e1cb96..d72326ea 100644 --- a/tests/compile-and-dump/Singletons/T124.golden +++ b/tests/compile-and-dump/Singletons/T124.golden @@ -7,8 +7,6 @@ Singletons/T124.hs:(0,0)-(0,0): Splicing declarations foo :: Bool -> () foo True = () foo False = () - type FooSym1 (a0123456789876543210 :: Bool) = - Foo a0123456789876543210 instance SuppressUnusedWarnings FooSym0 where suppressUnusedWarnings = snd (((,) FooSym0KindInference) ()) data FooSym0 :: (~>) Bool () @@ -17,6 +15,8 @@ Singletons/T124.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) => FooSym0 a0123456789876543210 type instance Apply FooSym0 a0123456789876543210 = FooSym1 a0123456789876543210 + type FooSym1 (a0123456789876543210 :: Bool) = + Foo a0123456789876543210 type family Foo (a :: Bool) :: () where Foo 'True = Tuple0Sym0 Foo 'False = Tuple0Sym0 diff --git a/tests/compile-and-dump/Singletons/T136.golden b/tests/compile-and-dump/Singletons/T136.golden index 16fde509..0e1505f1 100644 --- a/tests/compile-and-dump/Singletons/T136.golden +++ b/tests/compile-and-dump/Singletons/T136.golden @@ -33,8 +33,6 @@ Singletons/T136.hs:(0,0)-(0,0): Splicing declarations Succ_0123456789876543210 '[] = Apply (Apply (:@#@$) TrueSym0) '[] Succ_0123456789876543210 ('(:) 'False as) = Apply (Apply (:@#@$) TrueSym0) as Succ_0123456789876543210 ('(:) 'True as) = Apply (Apply (:@#@$) FalseSym0) (Apply SuccSym0 as) - type Succ_0123456789876543210Sym1 (a0123456789876543210 :: [Bool]) = - Succ_0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Succ_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Succ_0123456789876543210Sym0KindInference) ()) @@ -44,12 +42,12 @@ Singletons/T136.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Succ_0123456789876543210Sym0 arg) (Succ_0123456789876543210Sym1 arg) => Succ_0123456789876543210Sym0 a0123456789876543210 type instance Apply Succ_0123456789876543210Sym0 a0123456789876543210 = Succ_0123456789876543210Sym1 a0123456789876543210 + type Succ_0123456789876543210Sym1 (a0123456789876543210 :: [Bool]) = + Succ_0123456789876543210 a0123456789876543210 type family Pred_0123456789876543210 (a :: [Bool]) :: [Bool] where Pred_0123456789876543210 '[] = Apply ErrorSym0 "pred 0" Pred_0123456789876543210 ('(:) 'False as) = Apply (Apply (:@#@$) TrueSym0) (Apply PredSym0 as) Pred_0123456789876543210 ('(:) 'True as) = Apply (Apply (:@#@$) FalseSym0) as - type Pred_0123456789876543210Sym1 (a0123456789876543210 :: [Bool]) = - Pred_0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Pred_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Pred_0123456789876543210Sym0KindInference) ()) @@ -59,6 +57,8 @@ Singletons/T136.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Pred_0123456789876543210Sym0 arg) (Pred_0123456789876543210Sym1 arg) => Pred_0123456789876543210Sym0 a0123456789876543210 type instance Apply Pred_0123456789876543210Sym0 a0123456789876543210 = Pred_0123456789876543210Sym1 a0123456789876543210 + type Pred_0123456789876543210Sym1 (a0123456789876543210 :: [Bool]) = + Pred_0123456789876543210 a0123456789876543210 type family Case_0123456789876543210 i arg_0123456789876543210 t where Case_0123456789876543210 i arg_0123456789876543210 'True = '[] Case_0123456789876543210 i arg_0123456789876543210 'False = Apply SuccSym0 (Apply ToEnumSym0 (Apply PredSym0 i)) @@ -69,8 +69,6 @@ Singletons/T136.hs:(0,0)-(0,0): Splicing declarations Case_0123456789876543210 arg_0123456789876543210 i = Case_0123456789876543210 i arg_0123456789876543210 (Apply (Apply (<@#@$) i) (FromInteger 0)) type family ToEnum_0123456789876543210 (a :: GHC.Types.Nat) :: [Bool] where ToEnum_0123456789876543210 arg_0123456789876543210 = Case_0123456789876543210 arg_0123456789876543210 arg_0123456789876543210 - type ToEnum_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) = - ToEnum_0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings ToEnum_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) ToEnum_0123456789876543210Sym0KindInference) ()) @@ -80,12 +78,12 @@ Singletons/T136.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply ToEnum_0123456789876543210Sym0 arg) (ToEnum_0123456789876543210Sym1 arg) => ToEnum_0123456789876543210Sym0 a0123456789876543210 type instance Apply ToEnum_0123456789876543210Sym0 a0123456789876543210 = ToEnum_0123456789876543210Sym1 a0123456789876543210 + type ToEnum_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) = + ToEnum_0123456789876543210 a0123456789876543210 type family FromEnum_0123456789876543210 (a :: [Bool]) :: GHC.Types.Nat where FromEnum_0123456789876543210 '[] = FromInteger 0 FromEnum_0123456789876543210 ('(:) 'False as) = Apply (Apply (*@#@$) (FromInteger 2)) (Apply FromEnumSym0 as) FromEnum_0123456789876543210 ('(:) 'True as) = Apply (Apply (+@#@$) (FromInteger 1)) (Apply (Apply (*@#@$) (FromInteger 2)) (Apply FromEnumSym0 as)) - type FromEnum_0123456789876543210Sym1 (a0123456789876543210 :: [Bool]) = - FromEnum_0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings FromEnum_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) FromEnum_0123456789876543210Sym0KindInference) ()) @@ -95,6 +93,8 @@ Singletons/T136.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply FromEnum_0123456789876543210Sym0 arg) (FromEnum_0123456789876543210Sym1 arg) => FromEnum_0123456789876543210Sym0 a0123456789876543210 type instance Apply FromEnum_0123456789876543210Sym0 a0123456789876543210 = FromEnum_0123456789876543210Sym1 a0123456789876543210 + type FromEnum_0123456789876543210Sym1 (a0123456789876543210 :: [Bool]) = + FromEnum_0123456789876543210 a0123456789876543210 instance PEnum [Bool] where type Succ a = Apply Succ_0123456789876543210Sym0 a type Pred a = Apply Pred_0123456789876543210Sym0 a diff --git a/tests/compile-and-dump/Singletons/T136b.golden b/tests/compile-and-dump/Singletons/T136b.golden index cc186262..c60d8942 100644 --- a/tests/compile-and-dump/Singletons/T136b.golden +++ b/tests/compile-and-dump/Singletons/T136b.golden @@ -5,8 +5,6 @@ Singletons/T136b.hs:(0,0)-(0,0): Splicing declarations ======> class C a where meth :: a -> a - type MethSym1 (arg0123456789876543210 :: a0123456789876543210) = - Meth arg0123456789876543210 instance SuppressUnusedWarnings MethSym0 where suppressUnusedWarnings = snd (((,) MethSym0KindInference) ()) data MethSym0 :: forall a0123456789876543210. @@ -16,6 +14,8 @@ Singletons/T136b.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply MethSym0 arg) (MethSym1 arg) => MethSym0 arg0123456789876543210 type instance Apply MethSym0 arg0123456789876543210 = MethSym1 arg0123456789876543210 + type MethSym1 (arg0123456789876543210 :: a0123456789876543210) = + Meth arg0123456789876543210 class PC a where type Meth (arg :: a) :: a class SC a where @@ -31,8 +31,6 @@ Singletons/T136b.hs:(0,0)-(0,0): Splicing declarations meth = not type family Meth_0123456789876543210 (a :: Bool) :: Bool where Meth_0123456789876543210 a_0123456789876543210 = Apply NotSym0 a_0123456789876543210 - type Meth_0123456789876543210Sym1 (a0123456789876543210 :: Bool) = - Meth_0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Meth_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Meth_0123456789876543210Sym0KindInference) ()) @@ -42,6 +40,8 @@ Singletons/T136b.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Meth_0123456789876543210Sym0 arg) (Meth_0123456789876543210Sym1 arg) => Meth_0123456789876543210Sym0 a0123456789876543210 type instance Apply Meth_0123456789876543210Sym0 a0123456789876543210 = Meth_0123456789876543210Sym1 a0123456789876543210 + type Meth_0123456789876543210Sym1 (a0123456789876543210 :: Bool) = + Meth_0123456789876543210 a0123456789876543210 instance PC Bool where type Meth a = Apply Meth_0123456789876543210Sym0 a instance SC Bool where diff --git a/tests/compile-and-dump/Singletons/T145.golden b/tests/compile-and-dump/Singletons/T145.golden index abb64ec1..cad60c10 100644 --- a/tests/compile-and-dump/Singletons/T145.golden +++ b/tests/compile-and-dump/Singletons/T145.golden @@ -5,17 +5,6 @@ Singletons/T145.hs:(0,0)-(0,0): Splicing declarations ======> class Column (f :: Type -> Type) where col :: f a -> a -> Bool - type ColSym2 (arg0123456789876543210 :: f0123456789876543210 a0123456789876543210) (arg0123456789876543210 :: a0123456789876543210) = - Col arg0123456789876543210 arg0123456789876543210 - instance SuppressUnusedWarnings (ColSym1 arg0123456789876543210) where - suppressUnusedWarnings = snd (((,) ColSym1KindInference) ()) - data ColSym1 (arg0123456789876543210 :: f0123456789876543210 a0123456789876543210) :: (~>) a0123456789876543210 Bool - where - ColSym1KindInference :: forall arg0123456789876543210 - arg0123456789876543210 - arg. SameKind (Apply (ColSym1 arg0123456789876543210) arg) (ColSym2 arg0123456789876543210 arg) => - ColSym1 arg0123456789876543210 arg0123456789876543210 - type instance Apply (ColSym1 arg0123456789876543210) arg0123456789876543210 = ColSym2 arg0123456789876543210 arg0123456789876543210 instance SuppressUnusedWarnings ColSym0 where suppressUnusedWarnings = snd (((,) ColSym0KindInference) ()) data ColSym0 :: forall f0123456789876543210 a0123456789876543210. @@ -25,6 +14,17 @@ Singletons/T145.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply ColSym0 arg) (ColSym1 arg) => ColSym0 arg0123456789876543210 type instance Apply ColSym0 arg0123456789876543210 = ColSym1 arg0123456789876543210 + instance SuppressUnusedWarnings (ColSym1 arg0123456789876543210) where + suppressUnusedWarnings = snd (((,) ColSym1KindInference) ()) + data ColSym1 (arg0123456789876543210 :: f0123456789876543210 a0123456789876543210) :: (~>) a0123456789876543210 Bool + where + ColSym1KindInference :: forall arg0123456789876543210 + arg0123456789876543210 + arg. SameKind (Apply (ColSym1 arg0123456789876543210) arg) (ColSym2 arg0123456789876543210 arg) => + ColSym1 arg0123456789876543210 arg0123456789876543210 + type instance Apply (ColSym1 arg0123456789876543210) arg0123456789876543210 = ColSym2 arg0123456789876543210 arg0123456789876543210 + type ColSym2 (arg0123456789876543210 :: f0123456789876543210 a0123456789876543210) (arg0123456789876543210 :: a0123456789876543210) = + Col arg0123456789876543210 arg0123456789876543210 class PColumn (f :: Type -> Type) where type Col (arg :: f a) (arg :: a) :: Bool class SColumn (f :: Type -> Type) where diff --git a/tests/compile-and-dump/Singletons/T159.golden b/tests/compile-and-dump/Singletons/T159.golden index 033cfa9f..791268bb 100644 --- a/tests/compile-and-dump/Singletons/T159.golden +++ b/tests/compile-and-dump/Singletons/T159.golden @@ -43,9 +43,15 @@ Singletons/T159.hs:0:0:: Splicing declarations instance SingI 'F where sing = SF type N1Sym0 = 'N1 - type C1Sym2 (t0123456789876543210 :: T0) (t0123456789876543210 :: T1) = - 'C1 t0123456789876543210 t0123456789876543210 - infixr 5 `C1Sym2` + instance SuppressUnusedWarnings C1Sym0 where + suppressUnusedWarnings = snd (((,) C1Sym0KindInference) ()) + data C1Sym0 :: (~>) T0 ((~>) T1 T1) + where + C1Sym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply C1Sym0 arg) (C1Sym1 arg) => + C1Sym0 t0123456789876543210 + type instance Apply C1Sym0 t0123456789876543210 = C1Sym1 t0123456789876543210 + infixr 5 `C1Sym0` instance SuppressUnusedWarnings (C1Sym1 t0123456789876543210) where suppressUnusedWarnings = snd (((,) C1Sym1KindInference) ()) data C1Sym1 (t0123456789876543210 :: T0) :: (~>) T1 T1 @@ -56,18 +62,18 @@ Singletons/T159.hs:0:0:: Splicing declarations C1Sym1 t0123456789876543210 t0123456789876543210 type instance Apply (C1Sym1 t0123456789876543210) t0123456789876543210 = C1Sym2 t0123456789876543210 t0123456789876543210 infixr 5 `C1Sym1` - instance SuppressUnusedWarnings C1Sym0 where - suppressUnusedWarnings = snd (((,) C1Sym0KindInference) ()) - data C1Sym0 :: (~>) T0 ((~>) T1 T1) + type C1Sym2 (t0123456789876543210 :: T0) (t0123456789876543210 :: T1) = + 'C1 t0123456789876543210 t0123456789876543210 + infixr 5 `C1Sym2` + instance SuppressUnusedWarnings (:&&@#@$) where + suppressUnusedWarnings = snd (((,) (::&&@#@$###)) ()) + data (:&&@#@$) :: (~>) T0 ((~>) T1 T1) where - C1Sym0KindInference :: forall t0123456789876543210 - arg. SameKind (Apply C1Sym0 arg) (C1Sym1 arg) => - C1Sym0 t0123456789876543210 - type instance Apply C1Sym0 t0123456789876543210 = C1Sym1 t0123456789876543210 - infixr 5 `C1Sym0` - type (:&&@#@$$$) (t0123456789876543210 :: T0) (t0123456789876543210 :: T1) = - '(:&&) t0123456789876543210 t0123456789876543210 - infixr 5 :&&@#@$$$ + (::&&@#@$###) :: forall t0123456789876543210 + arg. SameKind (Apply (:&&@#@$) arg) ((:&&@#@$$) arg) => + (:&&@#@$) t0123456789876543210 + type instance Apply (:&&@#@$) t0123456789876543210 = (:&&@#@$$) t0123456789876543210 + infixr 5 :&&@#@$ instance SuppressUnusedWarnings ((:&&@#@$$) t0123456789876543210) where suppressUnusedWarnings = snd (((,) (::&&@#@$$###)) ()) data (:&&@#@$$) (t0123456789876543210 :: T0) :: (~>) T1 T1 @@ -78,15 +84,9 @@ Singletons/T159.hs:0:0:: Splicing declarations (:&&@#@$$) t0123456789876543210 t0123456789876543210 type instance Apply ((:&&@#@$$) t0123456789876543210) t0123456789876543210 = (:&&@#@$$$) t0123456789876543210 t0123456789876543210 infixr 5 :&&@#@$$ - instance SuppressUnusedWarnings (:&&@#@$) where - suppressUnusedWarnings = snd (((,) (::&&@#@$###)) ()) - data (:&&@#@$) :: (~>) T0 ((~>) T1 T1) - where - (::&&@#@$###) :: forall t0123456789876543210 - arg. SameKind (Apply (:&&@#@$) arg) ((:&&@#@$$) arg) => - (:&&@#@$) t0123456789876543210 - type instance Apply (:&&@#@$) t0123456789876543210 = (:&&@#@$$) t0123456789876543210 - infixr 5 :&&@#@$ + type (:&&@#@$$$) (t0123456789876543210 :: T0) (t0123456789876543210 :: T1) = + '(:&&) t0123456789876543210 t0123456789876543210 + infixr 5 :&&@#@$$$ data ST1 :: T1 -> GHC.Types.Type where SN1 :: ST1 ('N1 :: T1) @@ -141,9 +141,15 @@ Singletons/T159.hs:(0,0)-(0,0): Splicing declarations infixr 5 `C2` infixr 5 :|| type N2Sym0 = N2 - type C2Sym2 (t0123456789876543210 :: T0) (t0123456789876543210 :: T2) = - C2 t0123456789876543210 t0123456789876543210 - infixr 5 `C2Sym2` + instance SuppressUnusedWarnings C2Sym0 where + suppressUnusedWarnings = snd (((,) C2Sym0KindInference) ()) + data C2Sym0 :: (~>) T0 ((~>) T2 T2) + where + C2Sym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply C2Sym0 arg) (C2Sym1 arg) => + C2Sym0 t0123456789876543210 + type instance Apply C2Sym0 t0123456789876543210 = C2Sym1 t0123456789876543210 + infixr 5 `C2Sym0` instance SuppressUnusedWarnings (C2Sym1 t0123456789876543210) where suppressUnusedWarnings = snd (((,) C2Sym1KindInference) ()) data C2Sym1 (t0123456789876543210 :: T0) :: (~>) T2 T2 @@ -154,18 +160,18 @@ Singletons/T159.hs:(0,0)-(0,0): Splicing declarations C2Sym1 t0123456789876543210 t0123456789876543210 type instance Apply (C2Sym1 t0123456789876543210) t0123456789876543210 = C2Sym2 t0123456789876543210 t0123456789876543210 infixr 5 `C2Sym1` - instance SuppressUnusedWarnings C2Sym0 where - suppressUnusedWarnings = snd (((,) C2Sym0KindInference) ()) - data C2Sym0 :: (~>) T0 ((~>) T2 T2) + type C2Sym2 (t0123456789876543210 :: T0) (t0123456789876543210 :: T2) = + C2 t0123456789876543210 t0123456789876543210 + infixr 5 `C2Sym2` + instance SuppressUnusedWarnings (:||@#@$) where + suppressUnusedWarnings = snd (((,) (::||@#@$###)) ()) + data (:||@#@$) :: (~>) T0 ((~>) T2 T2) where - C2Sym0KindInference :: forall t0123456789876543210 - arg. SameKind (Apply C2Sym0 arg) (C2Sym1 arg) => - C2Sym0 t0123456789876543210 - type instance Apply C2Sym0 t0123456789876543210 = C2Sym1 t0123456789876543210 - infixr 5 `C2Sym0` - type (:||@#@$$$) (t0123456789876543210 :: T0) (t0123456789876543210 :: T2) = - (:||) t0123456789876543210 t0123456789876543210 - infixr 5 :||@#@$$$ + (::||@#@$###) :: forall t0123456789876543210 + arg. SameKind (Apply (:||@#@$) arg) ((:||@#@$$) arg) => + (:||@#@$) t0123456789876543210 + type instance Apply (:||@#@$) t0123456789876543210 = (:||@#@$$) t0123456789876543210 + infixr 5 :||@#@$ instance SuppressUnusedWarnings ((:||@#@$$) t0123456789876543210) where suppressUnusedWarnings = snd (((,) (::||@#@$$###)) ()) data (:||@#@$$) (t0123456789876543210 :: T0) :: (~>) T2 T2 @@ -176,15 +182,9 @@ Singletons/T159.hs:(0,0)-(0,0): Splicing declarations (:||@#@$$) t0123456789876543210 t0123456789876543210 type instance Apply ((:||@#@$$) t0123456789876543210) t0123456789876543210 = (:||@#@$$$) t0123456789876543210 t0123456789876543210 infixr 5 :||@#@$$ - instance SuppressUnusedWarnings (:||@#@$) where - suppressUnusedWarnings = snd (((,) (::||@#@$###)) ()) - data (:||@#@$) :: (~>) T0 ((~>) T2 T2) - where - (::||@#@$###) :: forall t0123456789876543210 - arg. SameKind (Apply (:||@#@$) arg) ((:||@#@$$) arg) => - (:||@#@$) t0123456789876543210 - type instance Apply (:||@#@$) t0123456789876543210 = (:||@#@$$) t0123456789876543210 - infixr 5 :||@#@$ + type (:||@#@$$$) (t0123456789876543210 :: T0) (t0123456789876543210 :: T2) = + (:||) t0123456789876543210 t0123456789876543210 + infixr 5 :||@#@$$$ infixr 5 :%|| infixr 5 `SC2` data ST2 :: T2 -> GHC.Types.Type diff --git a/tests/compile-and-dump/Singletons/T160.golden b/tests/compile-and-dump/Singletons/T160.golden index cb5af84d..86528780 100644 --- a/tests/compile-and-dump/Singletons/T160.golden +++ b/tests/compile-and-dump/Singletons/T160.golden @@ -5,8 +5,6 @@ Singletons/T160.hs:(0,0)-(0,0): Splicing declarations ======> foo :: (Num a, Eq a) => a -> a foo x = if (x == 0) then 1 else (typeError $ ShowType x) - type Let0123456789876543210Scrutinee_0123456789876543210Sym1 x0123456789876543210 = - Let0123456789876543210Scrutinee_0123456789876543210 x0123456789876543210 instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where suppressUnusedWarnings = snd @@ -19,13 +17,13 @@ Singletons/T160.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) => Let0123456789876543210Scrutinee_0123456789876543210Sym0 x0123456789876543210 type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 x0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210Sym1 x0123456789876543210 + type Let0123456789876543210Scrutinee_0123456789876543210Sym1 x0123456789876543210 = + Let0123456789876543210Scrutinee_0123456789876543210 x0123456789876543210 type family Let0123456789876543210Scrutinee_0123456789876543210 x where Let0123456789876543210Scrutinee_0123456789876543210 x = Apply (Apply (==@#@$) x) (FromInteger 0) type family Case_0123456789876543210 x t where Case_0123456789876543210 x 'True = FromInteger 1 Case_0123456789876543210 x 'False = Apply (Apply ($@#@$) TypeErrorSym0) (Apply ShowTypeSym0 x) - type FooSym1 (a0123456789876543210 :: a0123456789876543210) = - Foo a0123456789876543210 instance SuppressUnusedWarnings FooSym0 where suppressUnusedWarnings = snd (((,) FooSym0KindInference) ()) data FooSym0 :: forall a0123456789876543210. @@ -35,6 +33,8 @@ Singletons/T160.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) => FooSym0 a0123456789876543210 type instance Apply FooSym0 a0123456789876543210 = FooSym1 a0123456789876543210 + type FooSym1 (a0123456789876543210 :: a0123456789876543210) = + Foo a0123456789876543210 type family Foo (a :: a) :: a where Foo x = Case_0123456789876543210 x (Let0123456789876543210Scrutinee_0123456789876543210Sym1 x) sFoo :: diff --git a/tests/compile-and-dump/Singletons/T163.golden b/tests/compile-and-dump/Singletons/T163.golden index daca6932..b965c1eb 100644 --- a/tests/compile-and-dump/Singletons/T163.golden +++ b/tests/compile-and-dump/Singletons/T163.golden @@ -2,8 +2,6 @@ Singletons/T163.hs:0:0:: Splicing declarations singletons [d| data a + b = L a | R b |] ======> data (+) a b = L a | R b - type LSym1 (t0123456789876543210 :: a0123456789876543210) = - L t0123456789876543210 instance SuppressUnusedWarnings LSym0 where suppressUnusedWarnings = snd (((,) LSym0KindInference) ()) data LSym0 :: forall a0123456789876543210 b0123456789876543210. @@ -13,8 +11,8 @@ Singletons/T163.hs:0:0:: Splicing declarations arg. SameKind (Apply LSym0 arg) (LSym1 arg) => LSym0 t0123456789876543210 type instance Apply LSym0 t0123456789876543210 = LSym1 t0123456789876543210 - type RSym1 (t0123456789876543210 :: b0123456789876543210) = - R t0123456789876543210 + type LSym1 (t0123456789876543210 :: a0123456789876543210) = + L t0123456789876543210 instance SuppressUnusedWarnings RSym0 where suppressUnusedWarnings = snd (((,) RSym0KindInference) ()) data RSym0 :: forall b0123456789876543210 a0123456789876543210. @@ -24,6 +22,8 @@ Singletons/T163.hs:0:0:: Splicing declarations arg. SameKind (Apply RSym0 arg) (RSym1 arg) => RSym0 t0123456789876543210 type instance Apply RSym0 t0123456789876543210 = RSym1 t0123456789876543210 + type RSym1 (t0123456789876543210 :: b0123456789876543210) = + R t0123456789876543210 data (%+) :: forall a b. (+) a b -> GHC.Types.Type where SL :: forall a b (n :: a). (Sing n) -> (%+) (L n :: (+) a b) diff --git a/tests/compile-and-dump/Singletons/T166.golden b/tests/compile-and-dump/Singletons/T166.golden index 18db6f96..5ace9b37 100644 --- a/tests/compile-and-dump/Singletons/T166.golden +++ b/tests/compile-and-dump/Singletons/T166.golden @@ -5,18 +5,15 @@ Singletons/T166.hs:(0,0)-(0,0): Splicing declarations foo :: a -> [Bool] foo x s = foosPrec 0 x s |] ======> - type FoosPrecSym3 (arg0123456789876543210 :: Nat) (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: [Bool]) = - FoosPrec arg0123456789876543210 arg0123456789876543210 arg0123456789876543210 - instance SuppressUnusedWarnings (FoosPrecSym2 arg0123456789876543210 arg0123456789876543210) where - suppressUnusedWarnings = snd (((,) FoosPrecSym2KindInference) ()) - data FoosPrecSym2 (arg0123456789876543210 :: Nat) (arg0123456789876543210 :: a0123456789876543210) :: (~>) [Bool] [Bool] + instance SuppressUnusedWarnings FoosPrecSym0 where + suppressUnusedWarnings = snd (((,) FoosPrecSym0KindInference) ()) + data FoosPrecSym0 :: forall a0123456789876543210. + (~>) Nat ((~>) a0123456789876543210 ((~>) [Bool] [Bool])) where - FoosPrecSym2KindInference :: forall arg0123456789876543210 - arg0123456789876543210 - arg0123456789876543210 - arg. SameKind (Apply (FoosPrecSym2 arg0123456789876543210 arg0123456789876543210) arg) (FoosPrecSym3 arg0123456789876543210 arg0123456789876543210 arg) => - FoosPrecSym2 arg0123456789876543210 arg0123456789876543210 arg0123456789876543210 - type instance Apply (FoosPrecSym2 arg0123456789876543210 arg0123456789876543210) arg0123456789876543210 = FoosPrecSym3 arg0123456789876543210 arg0123456789876543210 arg0123456789876543210 + FoosPrecSym0KindInference :: forall arg0123456789876543210 + arg. SameKind (Apply FoosPrecSym0 arg) (FoosPrecSym1 arg) => + FoosPrecSym0 arg0123456789876543210 + type instance Apply FoosPrecSym0 arg0123456789876543210 = FoosPrecSym1 arg0123456789876543210 instance SuppressUnusedWarnings (FoosPrecSym1 arg0123456789876543210) where suppressUnusedWarnings = snd (((,) FoosPrecSym1KindInference) ()) data FoosPrecSym1 (arg0123456789876543210 :: Nat) :: forall a0123456789876543210. @@ -27,17 +24,18 @@ Singletons/T166.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (FoosPrecSym1 arg0123456789876543210) arg) (FoosPrecSym2 arg0123456789876543210 arg) => FoosPrecSym1 arg0123456789876543210 arg0123456789876543210 type instance Apply (FoosPrecSym1 arg0123456789876543210) arg0123456789876543210 = FoosPrecSym2 arg0123456789876543210 arg0123456789876543210 - instance SuppressUnusedWarnings FoosPrecSym0 where - suppressUnusedWarnings = snd (((,) FoosPrecSym0KindInference) ()) - data FoosPrecSym0 :: forall a0123456789876543210. - (~>) Nat ((~>) a0123456789876543210 ((~>) [Bool] [Bool])) + instance SuppressUnusedWarnings (FoosPrecSym2 arg0123456789876543210 arg0123456789876543210) where + suppressUnusedWarnings = snd (((,) FoosPrecSym2KindInference) ()) + data FoosPrecSym2 (arg0123456789876543210 :: Nat) (arg0123456789876543210 :: a0123456789876543210) :: (~>) [Bool] [Bool] where - FoosPrecSym0KindInference :: forall arg0123456789876543210 - arg. SameKind (Apply FoosPrecSym0 arg) (FoosPrecSym1 arg) => - FoosPrecSym0 arg0123456789876543210 - type instance Apply FoosPrecSym0 arg0123456789876543210 = FoosPrecSym1 arg0123456789876543210 - type FooSym1 (arg0123456789876543210 :: a0123456789876543210) = - Foo arg0123456789876543210 + FoosPrecSym2KindInference :: forall arg0123456789876543210 + arg0123456789876543210 + arg0123456789876543210 + arg. SameKind (Apply (FoosPrecSym2 arg0123456789876543210 arg0123456789876543210) arg) (FoosPrecSym3 arg0123456789876543210 arg0123456789876543210 arg) => + FoosPrecSym2 arg0123456789876543210 arg0123456789876543210 arg0123456789876543210 + type instance Apply (FoosPrecSym2 arg0123456789876543210 arg0123456789876543210) arg0123456789876543210 = FoosPrecSym3 arg0123456789876543210 arg0123456789876543210 arg0123456789876543210 + type FoosPrecSym3 (arg0123456789876543210 :: Nat) (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: [Bool]) = + FoosPrec arg0123456789876543210 arg0123456789876543210 arg0123456789876543210 instance SuppressUnusedWarnings FooSym0 where suppressUnusedWarnings = snd (((,) FooSym0KindInference) ()) data FooSym0 :: forall a0123456789876543210. @@ -47,10 +45,19 @@ Singletons/T166.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) => FooSym0 arg0123456789876543210 type instance Apply FooSym0 arg0123456789876543210 = FooSym1 arg0123456789876543210 + type FooSym1 (arg0123456789876543210 :: a0123456789876543210) = + Foo arg0123456789876543210 type family Lambda_0123456789876543210 x t where Lambda_0123456789876543210 x s = Apply (Apply (Apply FoosPrecSym0 (Data.Singletons.Prelude.Num.FromInteger 0)) x) s - type Lambda_0123456789876543210Sym2 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 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) @@ -61,19 +68,10 @@ Singletons/T166.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) => Lambda_0123456789876543210Sym1 x0123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym2 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 Lambda_0123456789876543210Sym2 x0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 x0123456789876543210 t0123456789876543210 type family Foo_0123456789876543210 (a :: a) :: [Bool] where Foo_0123456789876543210 x = Apply Lambda_0123456789876543210Sym0 x - type Foo_0123456789876543210Sym1 (a0123456789876543210 :: a0123456789876543210) = - Foo_0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Foo_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Foo_0123456789876543210Sym0KindInference) ()) @@ -84,6 +82,8 @@ Singletons/T166.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Foo_0123456789876543210Sym0 arg) (Foo_0123456789876543210Sym1 arg) => Foo_0123456789876543210Sym0 a0123456789876543210 type instance Apply Foo_0123456789876543210Sym0 a0123456789876543210 = Foo_0123456789876543210Sym1 a0123456789876543210 + type Foo_0123456789876543210Sym1 (a0123456789876543210 :: a0123456789876543210) = + Foo_0123456789876543210 a0123456789876543210 class PFoo a where type FoosPrec (arg :: Nat) (arg :: a) (arg :: [Bool]) :: [Bool] type Foo (arg :: a) :: [Bool] diff --git a/tests/compile-and-dump/Singletons/T167.golden b/tests/compile-and-dump/Singletons/T167.golden index a33099c2..d7d0a817 100644 --- a/tests/compile-and-dump/Singletons/T167.golden +++ b/tests/compile-and-dump/Singletons/T167.golden @@ -8,18 +8,15 @@ Singletons/T167.hs:(0,0)-(0,0): Splicing declarations instance Foo a => Foo [a] where foosPrec _ = fooList |] ======> - type FoosPrecSym3 (arg0123456789876543210 :: Nat) (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: [Bool]) = - FoosPrec arg0123456789876543210 arg0123456789876543210 arg0123456789876543210 - instance SuppressUnusedWarnings (FoosPrecSym2 arg0123456789876543210 arg0123456789876543210) where - suppressUnusedWarnings = snd (((,) FoosPrecSym2KindInference) ()) - data FoosPrecSym2 (arg0123456789876543210 :: Nat) (arg0123456789876543210 :: a0123456789876543210) :: (~>) [Bool] [Bool] + instance SuppressUnusedWarnings FoosPrecSym0 where + suppressUnusedWarnings = snd (((,) FoosPrecSym0KindInference) ()) + data FoosPrecSym0 :: forall a0123456789876543210. + (~>) Nat ((~>) a0123456789876543210 ((~>) [Bool] [Bool])) where - FoosPrecSym2KindInference :: forall arg0123456789876543210 - arg0123456789876543210 - arg0123456789876543210 - arg. SameKind (Apply (FoosPrecSym2 arg0123456789876543210 arg0123456789876543210) arg) (FoosPrecSym3 arg0123456789876543210 arg0123456789876543210 arg) => - FoosPrecSym2 arg0123456789876543210 arg0123456789876543210 arg0123456789876543210 - type instance Apply (FoosPrecSym2 arg0123456789876543210 arg0123456789876543210) arg0123456789876543210 = FoosPrecSym3 arg0123456789876543210 arg0123456789876543210 arg0123456789876543210 + FoosPrecSym0KindInference :: forall arg0123456789876543210 + arg. SameKind (Apply FoosPrecSym0 arg) (FoosPrecSym1 arg) => + FoosPrecSym0 arg0123456789876543210 + type instance Apply FoosPrecSym0 arg0123456789876543210 = FoosPrecSym1 arg0123456789876543210 instance SuppressUnusedWarnings (FoosPrecSym1 arg0123456789876543210) where suppressUnusedWarnings = snd (((,) FoosPrecSym1KindInference) ()) data FoosPrecSym1 (arg0123456789876543210 :: Nat) :: forall a0123456789876543210. @@ -30,26 +27,18 @@ Singletons/T167.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (FoosPrecSym1 arg0123456789876543210) arg) (FoosPrecSym2 arg0123456789876543210 arg) => FoosPrecSym1 arg0123456789876543210 arg0123456789876543210 type instance Apply (FoosPrecSym1 arg0123456789876543210) arg0123456789876543210 = FoosPrecSym2 arg0123456789876543210 arg0123456789876543210 - instance SuppressUnusedWarnings FoosPrecSym0 where - suppressUnusedWarnings = snd (((,) FoosPrecSym0KindInference) ()) - data FoosPrecSym0 :: forall a0123456789876543210. - (~>) Nat ((~>) a0123456789876543210 ((~>) [Bool] [Bool])) - where - FoosPrecSym0KindInference :: forall arg0123456789876543210 - arg. SameKind (Apply FoosPrecSym0 arg) (FoosPrecSym1 arg) => - FoosPrecSym0 arg0123456789876543210 - type instance Apply FoosPrecSym0 arg0123456789876543210 = FoosPrecSym1 arg0123456789876543210 - type FooListSym2 (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: [Bool]) = - FooList arg0123456789876543210 arg0123456789876543210 - instance SuppressUnusedWarnings (FooListSym1 arg0123456789876543210) where - suppressUnusedWarnings = snd (((,) FooListSym1KindInference) ()) - data FooListSym1 (arg0123456789876543210 :: a0123456789876543210) :: (~>) [Bool] [Bool] + instance SuppressUnusedWarnings (FoosPrecSym2 arg0123456789876543210 arg0123456789876543210) where + suppressUnusedWarnings = snd (((,) FoosPrecSym2KindInference) ()) + data FoosPrecSym2 (arg0123456789876543210 :: Nat) (arg0123456789876543210 :: a0123456789876543210) :: (~>) [Bool] [Bool] where - FooListSym1KindInference :: forall arg0123456789876543210 - arg0123456789876543210 - arg. SameKind (Apply (FooListSym1 arg0123456789876543210) arg) (FooListSym2 arg0123456789876543210 arg) => - FooListSym1 arg0123456789876543210 arg0123456789876543210 - type instance Apply (FooListSym1 arg0123456789876543210) arg0123456789876543210 = FooListSym2 arg0123456789876543210 arg0123456789876543210 + FoosPrecSym2KindInference :: forall arg0123456789876543210 + arg0123456789876543210 + arg0123456789876543210 + arg. SameKind (Apply (FoosPrecSym2 arg0123456789876543210 arg0123456789876543210) arg) (FoosPrecSym3 arg0123456789876543210 arg0123456789876543210 arg) => + FoosPrecSym2 arg0123456789876543210 arg0123456789876543210 arg0123456789876543210 + type instance Apply (FoosPrecSym2 arg0123456789876543210 arg0123456789876543210) arg0123456789876543210 = FoosPrecSym3 arg0123456789876543210 arg0123456789876543210 arg0123456789876543210 + type FoosPrecSym3 (arg0123456789876543210 :: Nat) (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: [Bool]) = + FoosPrec arg0123456789876543210 arg0123456789876543210 arg0123456789876543210 instance SuppressUnusedWarnings FooListSym0 where suppressUnusedWarnings = snd (((,) FooListSym0KindInference) ()) data FooListSym0 :: forall a0123456789876543210. @@ -59,20 +48,19 @@ Singletons/T167.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply FooListSym0 arg) (FooListSym1 arg) => FooListSym0 arg0123456789876543210 type instance Apply FooListSym0 arg0123456789876543210 = FooListSym1 arg0123456789876543210 + instance SuppressUnusedWarnings (FooListSym1 arg0123456789876543210) where + suppressUnusedWarnings = snd (((,) FooListSym1KindInference) ()) + data FooListSym1 (arg0123456789876543210 :: a0123456789876543210) :: (~>) [Bool] [Bool] + where + FooListSym1KindInference :: forall arg0123456789876543210 + arg0123456789876543210 + arg. SameKind (Apply (FooListSym1 arg0123456789876543210) arg) (FooListSym2 arg0123456789876543210 arg) => + FooListSym1 arg0123456789876543210 arg0123456789876543210 + type instance Apply (FooListSym1 arg0123456789876543210) arg0123456789876543210 = FooListSym2 arg0123456789876543210 arg0123456789876543210 + type FooListSym2 (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: [Bool]) = + FooList arg0123456789876543210 arg0123456789876543210 type family FooList_0123456789876543210 (a :: a) (a :: [Bool]) :: [Bool] where FooList_0123456789876543210 a_0123456789876543210 a_0123456789876543210 = Apply (Apply UndefinedSym0 a_0123456789876543210) a_0123456789876543210 - type FooList_0123456789876543210Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: [Bool]) = - FooList_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (FooList_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd (((,) FooList_0123456789876543210Sym1KindInference) ()) - data FooList_0123456789876543210Sym1 (a0123456789876543210 :: a0123456789876543210) :: (~>) [Bool] [Bool] - where - FooList_0123456789876543210Sym1KindInference :: forall a0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply (FooList_0123456789876543210Sym1 a0123456789876543210) arg) (FooList_0123456789876543210Sym2 a0123456789876543210 arg) => - FooList_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 - type instance Apply (FooList_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = FooList_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings FooList_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) FooList_0123456789876543210Sym0KindInference) ()) @@ -83,25 +71,34 @@ Singletons/T167.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply FooList_0123456789876543210Sym0 arg) (FooList_0123456789876543210Sym1 arg) => FooList_0123456789876543210Sym0 a0123456789876543210 type instance Apply FooList_0123456789876543210Sym0 a0123456789876543210 = FooList_0123456789876543210Sym1 a0123456789876543210 + instance SuppressUnusedWarnings (FooList_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) FooList_0123456789876543210Sym1KindInference) ()) + data FooList_0123456789876543210Sym1 (a0123456789876543210 :: a0123456789876543210) :: (~>) [Bool] [Bool] + where + FooList_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (FooList_0123456789876543210Sym1 a0123456789876543210) arg) (FooList_0123456789876543210Sym2 a0123456789876543210 arg) => + FooList_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (FooList_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = FooList_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 + type FooList_0123456789876543210Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: [Bool]) = + FooList_0123456789876543210 a0123456789876543210 a0123456789876543210 class PFoo a where type FoosPrec (arg :: Nat) (arg :: a) (arg :: [Bool]) :: [Bool] type FooList (arg :: a) (arg :: [Bool]) :: [Bool] type FooList a a = Apply (Apply FooList_0123456789876543210Sym0 a) a type family FoosPrec_0123456789876543210 (a :: Nat) (a :: [a]) (a :: [Bool]) :: [Bool] where FoosPrec_0123456789876543210 _ a_0123456789876543210 a_0123456789876543210 = Apply (Apply FooListSym0 a_0123456789876543210) a_0123456789876543210 - type FoosPrec_0123456789876543210Sym3 (a0123456789876543210 :: Nat) (a0123456789876543210 :: [a0123456789876543210]) (a0123456789876543210 :: [Bool]) = - FoosPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (FoosPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where + instance SuppressUnusedWarnings FoosPrec_0123456789876543210Sym0 where suppressUnusedWarnings - = snd (((,) FoosPrec_0123456789876543210Sym2KindInference) ()) - data FoosPrec_0123456789876543210Sym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: [a0123456789876543210]) :: (~>) [Bool] [Bool] + = snd (((,) FoosPrec_0123456789876543210Sym0KindInference) ()) + data FoosPrec_0123456789876543210Sym0 :: forall a0123456789876543210. + (~>) Nat ((~>) [a0123456789876543210] ((~>) [Bool] [Bool])) where - FoosPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 - a0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply (FoosPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (FoosPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => - FoosPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 - type instance Apply (FoosPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = FoosPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 + FoosPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply FoosPrec_0123456789876543210Sym0 arg) (FoosPrec_0123456789876543210Sym1 arg) => + FoosPrec_0123456789876543210Sym0 a0123456789876543210 + type instance Apply FoosPrec_0123456789876543210Sym0 a0123456789876543210 = FoosPrec_0123456789876543210Sym1 a0123456789876543210 instance SuppressUnusedWarnings (FoosPrec_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) FoosPrec_0123456789876543210Sym1KindInference) ()) @@ -113,16 +110,19 @@ Singletons/T167.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (FoosPrec_0123456789876543210Sym1 a0123456789876543210) arg) (FoosPrec_0123456789876543210Sym2 a0123456789876543210 arg) => FoosPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (FoosPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = FoosPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings FoosPrec_0123456789876543210Sym0 where + instance SuppressUnusedWarnings (FoosPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where suppressUnusedWarnings - = snd (((,) FoosPrec_0123456789876543210Sym0KindInference) ()) - data FoosPrec_0123456789876543210Sym0 :: forall a0123456789876543210. - (~>) Nat ((~>) [a0123456789876543210] ((~>) [Bool] [Bool])) + = snd (((,) FoosPrec_0123456789876543210Sym2KindInference) ()) + data FoosPrec_0123456789876543210Sym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: [a0123456789876543210]) :: (~>) [Bool] [Bool] where - FoosPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply FoosPrec_0123456789876543210Sym0 arg) (FoosPrec_0123456789876543210Sym1 arg) => - FoosPrec_0123456789876543210Sym0 a0123456789876543210 - type instance Apply FoosPrec_0123456789876543210Sym0 a0123456789876543210 = FoosPrec_0123456789876543210Sym1 a0123456789876543210 + FoosPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 + a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (FoosPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (FoosPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => + FoosPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type instance Apply (FoosPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = FoosPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type FoosPrec_0123456789876543210Sym3 (a0123456789876543210 :: Nat) (a0123456789876543210 :: [a0123456789876543210]) (a0123456789876543210 :: [Bool]) = + FoosPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance PFoo [a] where type FoosPrec a a a = Apply (Apply (Apply FoosPrec_0123456789876543210Sym0 a) a) a class SFoo a where diff --git a/tests/compile-and-dump/Singletons/T172.golden b/tests/compile-and-dump/Singletons/T172.golden index bf558364..d384343b 100644 --- a/tests/compile-and-dump/Singletons/T172.golden +++ b/tests/compile-and-dump/Singletons/T172.golden @@ -3,8 +3,14 @@ Singletons/T172.hs:(0,0)-(0,0): Splicing declarations [d| ($>) :: Nat -> Nat -> Nat ($>) = (+) |] ======> - type ($>@#@$$$) (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) = - ($>) a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings ($>@#@$) where + suppressUnusedWarnings = snd (((,) (:$>@#@$###)) ()) + data ($>@#@$) :: (~>) Nat ((~>) Nat Nat) + where + (:$>@#@$###) :: forall a0123456789876543210 + arg. SameKind (Apply ($>@#@$) arg) (($>@#@$$) arg) => + ($>@#@$) a0123456789876543210 + type instance Apply ($>@#@$) a0123456789876543210 = ($>@#@$$) a0123456789876543210 instance SuppressUnusedWarnings (($>@#@$$) a0123456789876543210) where suppressUnusedWarnings = snd (((,) (:$>@#@$$###)) ()) data ($>@#@$$) (a0123456789876543210 :: Nat) :: (~>) Nat Nat @@ -14,14 +20,8 @@ Singletons/T172.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (($>@#@$$) a0123456789876543210) arg) (($>@#@$$$) a0123456789876543210 arg) => ($>@#@$$) a0123456789876543210 a0123456789876543210 type instance Apply (($>@#@$$) a0123456789876543210) a0123456789876543210 = ($>@#@$$$) a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ($>@#@$) where - suppressUnusedWarnings = snd (((,) (:$>@#@$###)) ()) - data ($>@#@$) :: (~>) Nat ((~>) Nat Nat) - where - (:$>@#@$###) :: forall a0123456789876543210 - arg. SameKind (Apply ($>@#@$) arg) (($>@#@$$) arg) => - ($>@#@$) a0123456789876543210 - type instance Apply ($>@#@$) a0123456789876543210 = ($>@#@$$) a0123456789876543210 + type ($>@#@$$$) (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) = + ($>) a0123456789876543210 a0123456789876543210 type family ($>) (a :: Nat) (a :: Nat) :: Nat where ($>) a_0123456789876543210 a_0123456789876543210 = Apply (Apply (+@#@$) a_0123456789876543210) a_0123456789876543210 (%$>) :: diff --git a/tests/compile-and-dump/Singletons/T176.golden b/tests/compile-and-dump/Singletons/T176.golden index 534b0c3f..3d402895 100644 --- a/tests/compile-and-dump/Singletons/T176.golden +++ b/tests/compile-and-dump/Singletons/T176.golden @@ -26,8 +26,15 @@ Singletons/T176.hs:(0,0)-(0,0): Splicing declarations Case_0123456789876543210 arg_0123456789876543210 x _ = Baz1Sym0 type family Lambda_0123456789876543210 x t where Lambda_0123456789876543210 x arg_0123456789876543210 = Case_0123456789876543210 arg_0123456789876543210 x arg_0123456789876543210 - type Lambda_0123456789876543210Sym2 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 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) @@ -38,17 +45,8 @@ Singletons/T176.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) => Lambda_0123456789876543210Sym1 x0123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym2 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 Quux2Sym1 (a0123456789876543210 :: a0123456789876543210) = - Quux2 a0123456789876543210 + type Lambda_0123456789876543210Sym2 x0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 x0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings Quux2Sym0 where suppressUnusedWarnings = snd (((,) Quux2Sym0KindInference) ()) data Quux2Sym0 :: forall a0123456789876543210. @@ -58,8 +56,8 @@ Singletons/T176.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Quux2Sym0 arg) (Quux2Sym1 arg) => Quux2Sym0 a0123456789876543210 type instance Apply Quux2Sym0 a0123456789876543210 = Quux2Sym1 a0123456789876543210 - type Quux1Sym1 (a0123456789876543210 :: a0123456789876543210) = - Quux1 a0123456789876543210 + type Quux2Sym1 (a0123456789876543210 :: a0123456789876543210) = + Quux2 a0123456789876543210 instance SuppressUnusedWarnings Quux1Sym0 where suppressUnusedWarnings = snd (((,) Quux1Sym0KindInference) ()) data Quux1Sym0 :: forall a0123456789876543210. @@ -69,12 +67,21 @@ Singletons/T176.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Quux1Sym0 arg) (Quux1Sym1 arg) => Quux1Sym0 a0123456789876543210 type instance Apply Quux1Sym0 a0123456789876543210 = Quux1Sym1 a0123456789876543210 + type Quux1Sym1 (a0123456789876543210 :: a0123456789876543210) = + Quux1 a0123456789876543210 type family Quux2 (a :: a) :: a where Quux2 x = Apply (Apply Bar2Sym0 x) Baz2Sym0 type family Quux1 (a :: a) :: a where Quux1 x = Apply (Apply Bar1Sym0 x) (Apply Lambda_0123456789876543210Sym0 x) - type Bar1Sym2 (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) = - Bar1 arg0123456789876543210 arg0123456789876543210 + instance SuppressUnusedWarnings Bar1Sym0 where + suppressUnusedWarnings = snd (((,) Bar1Sym0KindInference) ()) + data Bar1Sym0 :: forall a0123456789876543210 b0123456789876543210. + (~>) a0123456789876543210 ((~>) ((~>) a0123456789876543210 b0123456789876543210) b0123456789876543210) + where + Bar1Sym0KindInference :: forall arg0123456789876543210 + arg. SameKind (Apply Bar1Sym0 arg) (Bar1Sym1 arg) => + Bar1Sym0 arg0123456789876543210 + type instance Apply Bar1Sym0 arg0123456789876543210 = Bar1Sym1 arg0123456789876543210 instance SuppressUnusedWarnings (Bar1Sym1 arg0123456789876543210) where suppressUnusedWarnings = snd (((,) Bar1Sym1KindInference) ()) data Bar1Sym1 (arg0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. @@ -85,21 +92,21 @@ Singletons/T176.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Bar1Sym1 arg0123456789876543210) arg) (Bar1Sym2 arg0123456789876543210 arg) => Bar1Sym1 arg0123456789876543210 arg0123456789876543210 type instance Apply (Bar1Sym1 arg0123456789876543210) arg0123456789876543210 = Bar1Sym2 arg0123456789876543210 arg0123456789876543210 - instance SuppressUnusedWarnings Bar1Sym0 where - suppressUnusedWarnings = snd (((,) Bar1Sym0KindInference) ()) - data Bar1Sym0 :: forall a0123456789876543210 b0123456789876543210. - (~>) a0123456789876543210 ((~>) ((~>) a0123456789876543210 b0123456789876543210) b0123456789876543210) - where - Bar1Sym0KindInference :: forall arg0123456789876543210 - arg. SameKind (Apply Bar1Sym0 arg) (Bar1Sym1 arg) => - Bar1Sym0 arg0123456789876543210 - type instance Apply Bar1Sym0 arg0123456789876543210 = Bar1Sym1 arg0123456789876543210 + type Bar1Sym2 (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) = + Bar1 arg0123456789876543210 arg0123456789876543210 type Baz1Sym0 = Baz1 class PFoo1 a where type Bar1 (arg :: a) (arg :: (~>) a b) :: b type Baz1 :: a - type Bar2Sym2 (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: b0123456789876543210) = - Bar2 arg0123456789876543210 arg0123456789876543210 + instance SuppressUnusedWarnings Bar2Sym0 where + suppressUnusedWarnings = snd (((,) Bar2Sym0KindInference) ()) + data Bar2Sym0 :: forall a0123456789876543210 b0123456789876543210. + (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210) + where + Bar2Sym0KindInference :: forall arg0123456789876543210 + arg. SameKind (Apply Bar2Sym0 arg) (Bar2Sym1 arg) => + Bar2Sym0 arg0123456789876543210 + type instance Apply Bar2Sym0 arg0123456789876543210 = Bar2Sym1 arg0123456789876543210 instance SuppressUnusedWarnings (Bar2Sym1 arg0123456789876543210) where suppressUnusedWarnings = snd (((,) Bar2Sym1KindInference) ()) data Bar2Sym1 (arg0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. @@ -110,15 +117,8 @@ Singletons/T176.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Bar2Sym1 arg0123456789876543210) arg) (Bar2Sym2 arg0123456789876543210 arg) => Bar2Sym1 arg0123456789876543210 arg0123456789876543210 type instance Apply (Bar2Sym1 arg0123456789876543210) arg0123456789876543210 = Bar2Sym2 arg0123456789876543210 arg0123456789876543210 - instance SuppressUnusedWarnings Bar2Sym0 where - suppressUnusedWarnings = snd (((,) Bar2Sym0KindInference) ()) - data Bar2Sym0 :: forall a0123456789876543210 b0123456789876543210. - (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210) - where - Bar2Sym0KindInference :: forall arg0123456789876543210 - arg. SameKind (Apply Bar2Sym0 arg) (Bar2Sym1 arg) => - Bar2Sym0 arg0123456789876543210 - type instance Apply Bar2Sym0 arg0123456789876543210 = Bar2Sym1 arg0123456789876543210 + type Bar2Sym2 (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: b0123456789876543210) = + Bar2 arg0123456789876543210 arg0123456789876543210 type Baz2Sym0 = Baz2 class PFoo2 a where type Bar2 (arg :: a) (arg :: b) :: b diff --git a/tests/compile-and-dump/Singletons/T178.golden b/tests/compile-and-dump/Singletons/T178.golden index 686322ca..cb0fd0a4 100644 --- a/tests/compile-and-dump/Singletons/T178.golden +++ b/tests/compile-and-dump/Singletons/T178.golden @@ -31,8 +31,15 @@ Singletons/T178.hs:(0,0)-(0,0): Splicing declarations Compare_0123456789876543210 Opt Many = LTSym0 Compare_0123456789876543210 Many Str = GTSym0 Compare_0123456789876543210 Many Opt = GTSym0 - type Compare_0123456789876543210Sym2 (a0123456789876543210 :: Occ) (a0123456789876543210 :: Occ) = - Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Compare_0123456789876543210Sym0KindInference) ()) + data Compare_0123456789876543210Sym0 :: (~>) Occ ((~>) Occ Ordering) + where + Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => + Compare_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 instance SuppressUnusedWarnings (Compare_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Compare_0123456789876543210Sym1KindInference) ()) @@ -43,34 +50,23 @@ Singletons/T178.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Compare_0123456789876543210Sym1 a0123456789876543210) arg) (Compare_0123456789876543210Sym2 a0123456789876543210 arg) => Compare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Compare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Compare_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd (((,) Compare_0123456789876543210Sym0KindInference) ()) - data Compare_0123456789876543210Sym0 :: (~>) Occ ((~>) Occ Ordering) - where - Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => - Compare_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 + type Compare_0123456789876543210Sym2 (a0123456789876543210 :: Occ) (a0123456789876543210 :: Occ) = + Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance POrd Occ where type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a type family ShowsPrec_0123456789876543210 (a :: Nat) (a :: Occ) (a :: Symbol) :: Symbol where ShowsPrec_0123456789876543210 _ Str a_0123456789876543210 = Apply (Apply ShowStringSym0 "Str") a_0123456789876543210 ShowsPrec_0123456789876543210 _ Opt a_0123456789876543210 = Apply (Apply ShowStringSym0 "Opt") a_0123456789876543210 ShowsPrec_0123456789876543210 _ Many a_0123456789876543210 = Apply (Apply ShowStringSym0 "Many") a_0123456789876543210 - type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Occ) (a0123456789876543210 :: Symbol) = - ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where suppressUnusedWarnings - = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) - data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Occ) :: (~>) Symbol Symbol + = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) + data ShowsPrec_0123456789876543210Sym0 :: (~>) Nat ((~>) Occ ((~>) Symbol Symbol)) where - ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 - a0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => - ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 - type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 + ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => + ShowsPrec_0123456789876543210Sym0 a0123456789876543210 + type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ()) @@ -81,15 +77,19 @@ Singletons/T178.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) => ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where + instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where suppressUnusedWarnings - = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) - data ShowsPrec_0123456789876543210Sym0 :: (~>) Nat ((~>) Occ ((~>) Symbol Symbol)) + = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) + data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Occ) :: (~>) Symbol Symbol where - ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => - ShowsPrec_0123456789876543210Sym0 a0123456789876543210 - type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 + ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 + a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => + ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Occ) (a0123456789876543210 :: Symbol) = + ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance PShow Occ where type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a type family Equals_0123456789876543210 (a :: Occ) (b :: Occ) :: Bool where diff --git a/tests/compile-and-dump/Singletons/T183.golden b/tests/compile-and-dump/Singletons/T183.golden index c2d23976..fb21fbcf 100644 --- a/tests/compile-and-dump/Singletons/T183.golden +++ b/tests/compile-and-dump/Singletons/T183.golden @@ -57,20 +57,15 @@ Singletons/T183.hs:(0,0)-(0,0): Splicing declarations g :: a -> b -> a g y _ = y in (g x) () - type Let0123456789876543210GSym3 x0123456789876543210 (a0123456789876543210 :: a) (a0123456789876543210 :: b0123456789876543210) = - Let0123456789876543210G x0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (Let0123456789876543210GSym2 a0123456789876543210 x0123456789876543210) where + instance SuppressUnusedWarnings Let0123456789876543210GSym0 where suppressUnusedWarnings - = snd (((,) Let0123456789876543210GSym2KindInference) ()) - data Let0123456789876543210GSym2 x0123456789876543210 (a0123456789876543210 :: a) :: forall b0123456789876543210. - (~>) b0123456789876543210 a + = snd (((,) Let0123456789876543210GSym0KindInference) ()) + data Let0123456789876543210GSym0 x0123456789876543210 where - Let0123456789876543210GSym2KindInference :: forall x0123456789876543210 - a0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply (Let0123456789876543210GSym2 x0123456789876543210 a0123456789876543210) arg) (Let0123456789876543210GSym3 x0123456789876543210 a0123456789876543210 arg) => - Let0123456789876543210GSym2 x0123456789876543210 a0123456789876543210 a0123456789876543210 - type instance Apply (Let0123456789876543210GSym2 a0123456789876543210 x0123456789876543210) a0123456789876543210 = Let0123456789876543210GSym3 a0123456789876543210 x0123456789876543210 a0123456789876543210 + Let0123456789876543210GSym0KindInference :: forall x0123456789876543210 + arg. SameKind (Apply Let0123456789876543210GSym0 arg) (Let0123456789876543210GSym1 arg) => + Let0123456789876543210GSym0 x0123456789876543210 + type instance Apply Let0123456789876543210GSym0 x0123456789876543210 = Let0123456789876543210GSym1 x0123456789876543210 instance SuppressUnusedWarnings (Let0123456789876543210GSym1 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Let0123456789876543210GSym1KindInference) ()) @@ -83,19 +78,22 @@ Singletons/T183.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Let0123456789876543210GSym1 x0123456789876543210) arg) (Let0123456789876543210GSym2 x0123456789876543210 arg) => Let0123456789876543210GSym1 x0123456789876543210 a0123456789876543210 type instance Apply (Let0123456789876543210GSym1 x0123456789876543210) a0123456789876543210 = Let0123456789876543210GSym2 x0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings Let0123456789876543210GSym0 where + instance SuppressUnusedWarnings (Let0123456789876543210GSym2 x0123456789876543210 a0123456789876543210) where suppressUnusedWarnings - = snd (((,) Let0123456789876543210GSym0KindInference) ()) - data Let0123456789876543210GSym0 x0123456789876543210 + = snd (((,) Let0123456789876543210GSym2KindInference) ()) + data Let0123456789876543210GSym2 x0123456789876543210 (a0123456789876543210 :: a) :: forall b0123456789876543210. + (~>) b0123456789876543210 a where - Let0123456789876543210GSym0KindInference :: forall x0123456789876543210 - arg. SameKind (Apply Let0123456789876543210GSym0 arg) (Let0123456789876543210GSym1 arg) => - Let0123456789876543210GSym0 x0123456789876543210 - type instance Apply Let0123456789876543210GSym0 x0123456789876543210 = Let0123456789876543210GSym1 x0123456789876543210 + Let0123456789876543210GSym2KindInference :: forall x0123456789876543210 + a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Let0123456789876543210GSym2 x0123456789876543210 a0123456789876543210) arg) (Let0123456789876543210GSym3 x0123456789876543210 a0123456789876543210 arg) => + Let0123456789876543210GSym2 x0123456789876543210 a0123456789876543210 a0123456789876543210 + type instance Apply (Let0123456789876543210GSym2 x0123456789876543210 a0123456789876543210) a0123456789876543210 = Let0123456789876543210GSym3 x0123456789876543210 a0123456789876543210 a0123456789876543210 + type Let0123456789876543210GSym3 x0123456789876543210 (a0123456789876543210 :: a) (a0123456789876543210 :: b0123456789876543210) = + Let0123456789876543210G x0123456789876543210 a0123456789876543210 a0123456789876543210 type family Let0123456789876543210G x (a :: a) (a :: b) :: a where Let0123456789876543210G x y _ = y - type Let0123456789876543210XSym1 wild_01234567898765432100123456789876543210 = - Let0123456789876543210X wild_01234567898765432100123456789876543210 instance SuppressUnusedWarnings Let0123456789876543210XSym0 where suppressUnusedWarnings = snd (((,) Let0123456789876543210XSym0KindInference) ()) @@ -105,10 +103,10 @@ Singletons/T183.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Let0123456789876543210XSym0 arg) (Let0123456789876543210XSym1 arg) => Let0123456789876543210XSym0 wild_01234567898765432100123456789876543210 type instance Apply Let0123456789876543210XSym0 wild_01234567898765432100123456789876543210 = Let0123456789876543210XSym1 wild_01234567898765432100123456789876543210 + type Let0123456789876543210XSym1 wild_01234567898765432100123456789876543210 = + Let0123456789876543210X wild_01234567898765432100123456789876543210 type family Let0123456789876543210X wild_0123456789876543210 where Let0123456789876543210X wild_0123456789876543210 = Apply JustSym0 (wild_0123456789876543210 :: a) :: Maybe a - type Let0123456789876543210Scrutinee_0123456789876543210Sym1 x0123456789876543210 = - Let0123456789876543210Scrutinee_0123456789876543210 x0123456789876543210 instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where suppressUnusedWarnings = snd @@ -121,6 +119,8 @@ Singletons/T183.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) => Let0123456789876543210Scrutinee_0123456789876543210Sym0 x0123456789876543210 type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 x0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210Sym1 x0123456789876543210 + type Let0123456789876543210Scrutinee_0123456789876543210Sym1 x0123456789876543210 = + Let0123456789876543210Scrutinee_0123456789876543210 x0123456789876543210 type family Let0123456789876543210Scrutinee_0123456789876543210 x where Let0123456789876543210Scrutinee_0123456789876543210 x = x :: Maybe a type family Case_0123456789876543210 x t where @@ -130,8 +130,15 @@ Singletons/T183.hs:(0,0)-(0,0): Splicing declarations y :: b) = Apply (Apply Tuple2Sym0 (y :: b)) (x :: a) type family Lambda_0123456789876543210 a_0123456789876543210 t where Lambda_0123456789876543210 a_0123456789876543210 arg_0123456789876543210 = Case_0123456789876543210 arg_0123456789876543210 a_0123456789876543210 arg_0123456789876543210 - type Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 t0123456789876543210 = - Lambda_0123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + 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 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) @@ -142,17 +149,8 @@ Singletons/T183.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 t0123456789876543210 - 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 Let0123456789876543210Scrutinee_0123456789876543210Sym1 x0123456789876543210 = - Let0123456789876543210Scrutinee_0123456789876543210 x0123456789876543210 + type Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where suppressUnusedWarnings = snd @@ -165,12 +163,12 @@ Singletons/T183.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) => Let0123456789876543210Scrutinee_0123456789876543210Sym0 x0123456789876543210 type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 x0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210Sym1 x0123456789876543210 + type Let0123456789876543210Scrutinee_0123456789876543210Sym1 x0123456789876543210 = + Let0123456789876543210Scrutinee_0123456789876543210 x0123456789876543210 type family Let0123456789876543210Scrutinee_0123456789876543210 x where Let0123456789876543210Scrutinee_0123456789876543210 x = Apply JustSym0 x type family Case_0123456789876543210 x t where Case_0123456789876543210 x ('Just y :: Maybe Bool) = y :: Bool - type Foo9Sym1 (a0123456789876543210 :: a0123456789876543210) = - Foo9 a0123456789876543210 instance SuppressUnusedWarnings Foo9Sym0 where suppressUnusedWarnings = snd (((,) Foo9Sym0KindInference) ()) data Foo9Sym0 :: forall a0123456789876543210. @@ -180,8 +178,8 @@ Singletons/T183.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Foo9Sym0 arg) (Foo9Sym1 arg) => Foo9Sym0 a0123456789876543210 type instance Apply Foo9Sym0 a0123456789876543210 = Foo9Sym1 a0123456789876543210 - type Foo8Sym1 (a0123456789876543210 :: Maybe a0123456789876543210) = - Foo8 a0123456789876543210 + type Foo9Sym1 (a0123456789876543210 :: a0123456789876543210) = + Foo9 a0123456789876543210 instance SuppressUnusedWarnings Foo8Sym0 where suppressUnusedWarnings = snd (((,) Foo8Sym0KindInference) ()) data Foo8Sym0 :: forall a0123456789876543210. @@ -191,8 +189,17 @@ Singletons/T183.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Foo8Sym0 arg) (Foo8Sym1 arg) => Foo8Sym0 a0123456789876543210 type instance Apply Foo8Sym0 a0123456789876543210 = Foo8Sym1 a0123456789876543210 - type Foo7Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = - Foo7 a0123456789876543210 a0123456789876543210 + type Foo8Sym1 (a0123456789876543210 :: Maybe a0123456789876543210) = + Foo8 a0123456789876543210 + instance SuppressUnusedWarnings Foo7Sym0 where + suppressUnusedWarnings = snd (((,) Foo7Sym0KindInference) ()) + data Foo7Sym0 :: forall a0123456789876543210 b0123456789876543210. + (~>) a0123456789876543210 ((~>) b0123456789876543210 a0123456789876543210) + where + Foo7Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Foo7Sym0 arg) (Foo7Sym1 arg) => + Foo7Sym0 a0123456789876543210 + type instance Apply Foo7Sym0 a0123456789876543210 = Foo7Sym1 a0123456789876543210 instance SuppressUnusedWarnings (Foo7Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Foo7Sym1KindInference) ()) data Foo7Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. @@ -203,17 +210,8 @@ Singletons/T183.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Foo7Sym1 a0123456789876543210) arg) (Foo7Sym2 a0123456789876543210 arg) => Foo7Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Foo7Sym1 a0123456789876543210) a0123456789876543210 = Foo7Sym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings Foo7Sym0 where - suppressUnusedWarnings = snd (((,) Foo7Sym0KindInference) ()) - data Foo7Sym0 :: forall a0123456789876543210 b0123456789876543210. - (~>) a0123456789876543210 ((~>) b0123456789876543210 a0123456789876543210) - where - Foo7Sym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply Foo7Sym0 arg) (Foo7Sym1 arg) => - Foo7Sym0 a0123456789876543210 - type instance Apply Foo7Sym0 a0123456789876543210 = Foo7Sym1 a0123456789876543210 - type Foo6Sym1 (a0123456789876543210 :: Maybe (Maybe a0123456789876543210)) = - Foo6 a0123456789876543210 + type Foo7Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = + Foo7 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Foo6Sym0 where suppressUnusedWarnings = snd (((,) Foo6Sym0KindInference) ()) data Foo6Sym0 :: forall a0123456789876543210. @@ -223,8 +221,8 @@ Singletons/T183.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Foo6Sym0 arg) (Foo6Sym1 arg) => Foo6Sym0 a0123456789876543210 type instance Apply Foo6Sym0 a0123456789876543210 = Foo6Sym1 a0123456789876543210 - type Foo5Sym1 (a0123456789876543210 :: Maybe (Maybe a0123456789876543210)) = - Foo5 a0123456789876543210 + type Foo6Sym1 (a0123456789876543210 :: Maybe (Maybe a0123456789876543210)) = + Foo6 a0123456789876543210 instance SuppressUnusedWarnings Foo5Sym0 where suppressUnusedWarnings = snd (((,) Foo5Sym0KindInference) ()) data Foo5Sym0 :: forall a0123456789876543210. @@ -234,9 +232,8 @@ Singletons/T183.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Foo5Sym0 arg) (Foo5Sym1 arg) => Foo5Sym0 a0123456789876543210 type instance Apply Foo5Sym0 a0123456789876543210 = Foo5Sym1 a0123456789876543210 - type Foo4Sym1 (a0123456789876543210 :: (a0123456789876543210, - b0123456789876543210)) = - Foo4 a0123456789876543210 + type Foo5Sym1 (a0123456789876543210 :: Maybe (Maybe a0123456789876543210)) = + Foo5 a0123456789876543210 instance SuppressUnusedWarnings Foo4Sym0 where suppressUnusedWarnings = snd (((,) Foo4Sym0KindInference) ()) data Foo4Sym0 :: forall a0123456789876543210 b0123456789876543210. @@ -247,8 +244,9 @@ Singletons/T183.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Foo4Sym0 arg) (Foo4Sym1 arg) => Foo4Sym0 a0123456789876543210 type instance Apply Foo4Sym0 a0123456789876543210 = Foo4Sym1 a0123456789876543210 - type Foo3Sym1 (a0123456789876543210 :: Maybe a0123456789876543210) = - Foo3 a0123456789876543210 + type Foo4Sym1 (a0123456789876543210 :: (a0123456789876543210, + b0123456789876543210)) = + Foo4 a0123456789876543210 instance SuppressUnusedWarnings Foo3Sym0 where suppressUnusedWarnings = snd (((,) Foo3Sym0KindInference) ()) data Foo3Sym0 :: forall a0123456789876543210. @@ -258,8 +256,8 @@ Singletons/T183.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Foo3Sym0 arg) (Foo3Sym1 arg) => Foo3Sym0 a0123456789876543210 type instance Apply Foo3Sym0 a0123456789876543210 = Foo3Sym1 a0123456789876543210 - type Foo2Sym1 (a0123456789876543210 :: Maybe a0123456789876543210) = - Foo2 a0123456789876543210 + type Foo3Sym1 (a0123456789876543210 :: Maybe a0123456789876543210) = + Foo3 a0123456789876543210 instance SuppressUnusedWarnings Foo2Sym0 where suppressUnusedWarnings = snd (((,) Foo2Sym0KindInference) ()) data Foo2Sym0 :: forall a0123456789876543210. @@ -269,8 +267,8 @@ Singletons/T183.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Foo2Sym0 arg) (Foo2Sym1 arg) => Foo2Sym0 a0123456789876543210 type instance Apply Foo2Sym0 a0123456789876543210 = Foo2Sym1 a0123456789876543210 - type Foo1Sym1 (a0123456789876543210 :: Maybe a0123456789876543210) = - Foo1 a0123456789876543210 + type Foo2Sym1 (a0123456789876543210 :: Maybe a0123456789876543210) = + Foo2 a0123456789876543210 instance SuppressUnusedWarnings Foo1Sym0 where suppressUnusedWarnings = snd (((,) Foo1Sym0KindInference) ()) data Foo1Sym0 :: forall a0123456789876543210. @@ -280,7 +278,8 @@ Singletons/T183.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Foo1Sym0 arg) (Foo1Sym1 arg) => Foo1Sym0 a0123456789876543210 type instance Apply Foo1Sym0 a0123456789876543210 = Foo1Sym1 a0123456789876543210 - type GSym1 a0123456789876543210 = G a0123456789876543210 + type Foo1Sym1 (a0123456789876543210 :: Maybe a0123456789876543210) = + Foo1 a0123456789876543210 instance SuppressUnusedWarnings GSym0 where suppressUnusedWarnings = snd (((,) GSym0KindInference) ()) data GSym0 a0123456789876543210 @@ -289,7 +288,7 @@ Singletons/T183.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply GSym0 arg) (GSym1 arg) => GSym0 a0123456789876543210 type instance Apply GSym0 a0123456789876543210 = GSym1 a0123456789876543210 - type F3Sym1 a0123456789876543210 = F3 a0123456789876543210 + type GSym1 a0123456789876543210 = G a0123456789876543210 instance SuppressUnusedWarnings F3Sym0 where suppressUnusedWarnings = snd (((,) F3Sym0KindInference) ()) data F3Sym0 a0123456789876543210 @@ -298,7 +297,7 @@ Singletons/T183.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply F3Sym0 arg) (F3Sym1 arg) => F3Sym0 a0123456789876543210 type instance Apply F3Sym0 a0123456789876543210 = F3Sym1 a0123456789876543210 - type F2Sym1 a0123456789876543210 = F2 a0123456789876543210 + type F3Sym1 a0123456789876543210 = F3 a0123456789876543210 instance SuppressUnusedWarnings F2Sym0 where suppressUnusedWarnings = snd (((,) F2Sym0KindInference) ()) data F2Sym0 a0123456789876543210 @@ -307,7 +306,7 @@ Singletons/T183.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply F2Sym0 arg) (F2Sym1 arg) => F2Sym0 a0123456789876543210 type instance Apply F2Sym0 a0123456789876543210 = F2Sym1 a0123456789876543210 - type F1Sym1 a0123456789876543210 = F1 a0123456789876543210 + type F2Sym1 a0123456789876543210 = F2 a0123456789876543210 instance SuppressUnusedWarnings F1Sym0 where suppressUnusedWarnings = snd (((,) F1Sym0KindInference) ()) data F1Sym0 a0123456789876543210 @@ -316,6 +315,7 @@ Singletons/T183.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply F1Sym0 arg) (F1Sym1 arg) => F1Sym0 a0123456789876543210 type instance Apply F1Sym0 a0123456789876543210 = F1Sym1 a0123456789876543210 + type F1Sym1 a0123456789876543210 = F1 a0123456789876543210 type family Foo9 (a :: a) :: a where Foo9 (x :: a) = Apply (Apply (Let0123456789876543210GSym1 x) x) Tuple0Sym0 type family Foo8 (a :: Maybe a) :: Maybe a where diff --git a/tests/compile-and-dump/Singletons/T184.golden b/tests/compile-and-dump/Singletons/T184.golden index 56a30433..a87e1509 100644 --- a/tests/compile-and-dump/Singletons/T184.golden +++ b/tests/compile-and-dump/Singletons/T184.golden @@ -27,8 +27,15 @@ Singletons/T184.hs:(0,0)-(0,0): Splicing declarations trues xs = [x | x <- xs, x] type family Lambda_0123456789876543210 xs t where Lambda_0123456789876543210 xs x = Apply (Apply (>>@#@$) (Apply GuardSym0 x)) (Apply ReturnSym0 x) - type Lambda_0123456789876543210Sym2 xs0123456789876543210 t0123456789876543210 = - Lambda_0123456789876543210 xs0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 xs0123456789876543210 + where + Lambda_0123456789876543210Sym0KindInference :: forall xs0123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 xs0123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 xs0123456789876543210 = Lambda_0123456789876543210Sym1 xs0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 xs0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) @@ -39,32 +46,30 @@ Singletons/T184.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Lambda_0123456789876543210Sym1 xs0123456789876543210) arg) (Lambda_0123456789876543210Sym2 xs0123456789876543210 arg) => Lambda_0123456789876543210Sym1 xs0123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 xs0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym2 xs0123456789876543210 t0123456789876543210 + type Lambda_0123456789876543210Sym2 xs0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 xs0123456789876543210 t0123456789876543210 + type family Lambda_0123456789876543210 x xs ys t where + Lambda_0123456789876543210 x xs ys y = Apply ReturnSym0 (Apply (Apply Tuple2Sym0 x) y) instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) - data Lambda_0123456789876543210Sym0 xs0123456789876543210 + data Lambda_0123456789876543210Sym0 x0123456789876543210 where - Lambda_0123456789876543210Sym0KindInference :: forall xs0123456789876543210 + Lambda_0123456789876543210Sym0KindInference :: forall x0123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 xs0123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 xs0123456789876543210 = Lambda_0123456789876543210Sym1 xs0123456789876543210 - type family Lambda_0123456789876543210 x xs ys t where - Lambda_0123456789876543210 x xs ys y = Apply ReturnSym0 (Apply (Apply Tuple2Sym0 x) y) - type Lambda_0123456789876543210Sym4 x0123456789876543210 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 = - Lambda_0123456789876543210 x0123456789876543210 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 ys0123456789876543210 xs0123456789876543210 x0123456789876543210) where + Lambda_0123456789876543210Sym0 x0123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) - data Lambda_0123456789876543210Sym3 x0123456789876543210 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) + data Lambda_0123456789876543210Sym1 x0123456789876543210 xs0123456789876543210 where - Lambda_0123456789876543210Sym3KindInference :: forall x0123456789876543210 + Lambda_0123456789876543210Sym1KindInference :: forall x0123456789876543210 xs0123456789876543210 - ys0123456789876543210 - t0123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym3 x0123456789876543210 xs0123456789876543210 ys0123456789876543210) arg) (Lambda_0123456789876543210Sym4 x0123456789876543210 xs0123456789876543210 ys0123456789876543210 arg) => - Lambda_0123456789876543210Sym3 x0123456789876543210 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym3 ys0123456789876543210 xs0123456789876543210 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym4 ys0123456789876543210 xs0123456789876543210 x0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 xs0123456789876543210 x0123456789876543210) where + arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) => + Lambda_0123456789876543210Sym1 x0123456789876543210 xs0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) xs0123456789876543210 = Lambda_0123456789876543210Sym2 x0123456789876543210 xs0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 x0123456789876543210 xs0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) data Lambda_0123456789876543210Sym2 x0123456789876543210 xs0123456789876543210 ys0123456789876543210 @@ -74,41 +79,32 @@ Singletons/T184.hs:(0,0)-(0,0): Splicing declarations ys0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 xs0123456789876543210) arg) (Lambda_0123456789876543210Sym3 x0123456789876543210 xs0123456789876543210 arg) => Lambda_0123456789876543210Sym2 x0123456789876543210 xs0123456789876543210 ys0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 xs0123456789876543210 x0123456789876543210) ys0123456789876543210 = Lambda_0123456789876543210Sym3 xs0123456789876543210 x0123456789876543210 ys0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where + type instance Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 xs0123456789876543210) ys0123456789876543210 = Lambda_0123456789876543210Sym3 x0123456789876543210 xs0123456789876543210 ys0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 x0123456789876543210 xs0123456789876543210 ys0123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) - data Lambda_0123456789876543210Sym1 x0123456789876543210 xs0123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) + data Lambda_0123456789876543210Sym3 x0123456789876543210 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 where - Lambda_0123456789876543210Sym1KindInference :: forall x0123456789876543210 + Lambda_0123456789876543210Sym3KindInference :: forall x0123456789876543210 xs0123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) => - Lambda_0123456789876543210Sym1 x0123456789876543210 xs0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) xs0123456789876543210 = Lambda_0123456789876543210Sym2 x0123456789876543210 xs0123456789876543210 + ys0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym3 x0123456789876543210 xs0123456789876543210 ys0123456789876543210) arg) (Lambda_0123456789876543210Sym4 x0123456789876543210 xs0123456789876543210 ys0123456789876543210 arg) => + Lambda_0123456789876543210Sym3 x0123456789876543210 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym3 x0123456789876543210 xs0123456789876543210 ys0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym4 x0123456789876543210 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 + type Lambda_0123456789876543210Sym4 x0123456789876543210 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 x0123456789876543210 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 + type family Lambda_0123456789876543210 xs ys t where + Lambda_0123456789876543210 xs ys x = Apply (Apply (>>=@#@$) ys) (Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) xs) ys) instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) - data Lambda_0123456789876543210Sym0 x0123456789876543210 + data Lambda_0123456789876543210Sym0 xs0123456789876543210 where - Lambda_0123456789876543210Sym0KindInference :: forall x0123456789876543210 + Lambda_0123456789876543210Sym0KindInference :: forall xs0123456789876543210 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 xs ys t where - Lambda_0123456789876543210 xs ys x = Apply (Apply (>>=@#@$) ys) (Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) xs) ys) - type Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 = - Lambda_0123456789876543210 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 ys0123456789876543210 xs0123456789876543210) where - suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) - data Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 - where - Lambda_0123456789876543210Sym2KindInference :: forall xs0123456789876543210 - ys0123456789876543210 - t0123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210) arg) (Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 arg) => - Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 ys0123456789876543210 xs0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym3 ys0123456789876543210 xs0123456789876543210 t0123456789876543210 + Lambda_0123456789876543210Sym0 xs0123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 xs0123456789876543210 = Lambda_0123456789876543210Sym1 xs0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 xs0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) @@ -119,20 +115,7 @@ Singletons/T184.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Lambda_0123456789876543210Sym1 xs0123456789876543210) arg) (Lambda_0123456789876543210Sym2 xs0123456789876543210 arg) => Lambda_0123456789876543210Sym1 xs0123456789876543210 ys0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 xs0123456789876543210) ys0123456789876543210 = Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) - data Lambda_0123456789876543210Sym0 xs0123456789876543210 - where - Lambda_0123456789876543210Sym0KindInference :: forall xs0123456789876543210 - arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 xs0123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 xs0123456789876543210 = Lambda_0123456789876543210Sym1 xs0123456789876543210 - type family Lambda_0123456789876543210 xs ys t where - Lambda_0123456789876543210 xs ys x = Apply ReturnSym0 x - type Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 = - Lambda_0123456789876543210 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 ys0123456789876543210 xs0123456789876543210) where + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) data Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 @@ -142,7 +125,20 @@ Singletons/T184.hs:(0,0)-(0,0): Splicing declarations t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210) arg) (Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 arg) => Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 ys0123456789876543210 xs0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym3 ys0123456789876543210 xs0123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 + type Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 + type family Lambda_0123456789876543210 xs ys t where + Lambda_0123456789876543210 xs ys x = Apply ReturnSym0 x + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 xs0123456789876543210 + where + Lambda_0123456789876543210Sym0KindInference :: forall xs0123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 xs0123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 xs0123456789876543210 = Lambda_0123456789876543210Sym1 xs0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 xs0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) @@ -153,20 +149,7 @@ Singletons/T184.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Lambda_0123456789876543210Sym1 xs0123456789876543210) arg) (Lambda_0123456789876543210Sym2 xs0123456789876543210 arg) => Lambda_0123456789876543210Sym1 xs0123456789876543210 ys0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 xs0123456789876543210) ys0123456789876543210 = Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) - data Lambda_0123456789876543210Sym0 xs0123456789876543210 - where - Lambda_0123456789876543210Sym0KindInference :: forall xs0123456789876543210 - arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 xs0123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 xs0123456789876543210 = Lambda_0123456789876543210Sym1 xs0123456789876543210 - type family Lambda_0123456789876543210 xs ys t where - Lambda_0123456789876543210 xs ys y = Apply ReturnSym0 y - type Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 = - Lambda_0123456789876543210 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 ys0123456789876543210 xs0123456789876543210) where + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) data Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 @@ -176,7 +159,20 @@ Singletons/T184.hs:(0,0)-(0,0): Splicing declarations t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210) arg) (Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 arg) => Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 ys0123456789876543210 xs0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym3 ys0123456789876543210 xs0123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 + type Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 + type family Lambda_0123456789876543210 xs ys t where + Lambda_0123456789876543210 xs ys y = Apply ReturnSym0 y + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 xs0123456789876543210 + where + Lambda_0123456789876543210Sym0KindInference :: forall xs0123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 xs0123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 xs0123456789876543210 = Lambda_0123456789876543210Sym1 xs0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 xs0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) @@ -187,23 +183,7 @@ Singletons/T184.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Lambda_0123456789876543210Sym1 xs0123456789876543210) arg) (Lambda_0123456789876543210Sym2 xs0123456789876543210 arg) => Lambda_0123456789876543210Sym1 xs0123456789876543210 ys0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 xs0123456789876543210) ys0123456789876543210 = Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) - data Lambda_0123456789876543210Sym0 xs0123456789876543210 - where - Lambda_0123456789876543210Sym0KindInference :: forall xs0123456789876543210 - arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 xs0123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 xs0123456789876543210 = Lambda_0123456789876543210Sym1 xs0123456789876543210 - type family Case_0123456789876543210 arg_0123456789876543210 xs ys t where - Case_0123456789876543210 arg_0123456789876543210 xs ys '(x, - y) = Apply ReturnSym0 (Apply (Apply Tuple2Sym0 x) y) - type family Lambda_0123456789876543210 xs ys t where - Lambda_0123456789876543210 xs ys arg_0123456789876543210 = Case_0123456789876543210 arg_0123456789876543210 xs ys arg_0123456789876543210 - type Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 = - Lambda_0123456789876543210 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 ys0123456789876543210 xs0123456789876543210) where + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) data Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 @@ -213,7 +193,23 @@ Singletons/T184.hs:(0,0)-(0,0): Splicing declarations t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210) arg) (Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 arg) => Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 ys0123456789876543210 xs0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym3 ys0123456789876543210 xs0123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 + type Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 + type family Case_0123456789876543210 arg_0123456789876543210 xs ys t where + Case_0123456789876543210 arg_0123456789876543210 xs ys '(x, + y) = Apply ReturnSym0 (Apply (Apply Tuple2Sym0 x) y) + type family Lambda_0123456789876543210 xs ys t where + Lambda_0123456789876543210 xs ys arg_0123456789876543210 = Case_0123456789876543210 arg_0123456789876543210 xs ys arg_0123456789876543210 + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 xs0123456789876543210 + where + Lambda_0123456789876543210Sym0KindInference :: forall xs0123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 xs0123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 xs0123456789876543210 = Lambda_0123456789876543210Sym1 xs0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 xs0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) @@ -224,32 +220,41 @@ Singletons/T184.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Lambda_0123456789876543210Sym1 xs0123456789876543210) arg) (Lambda_0123456789876543210Sym2 xs0123456789876543210 arg) => Lambda_0123456789876543210Sym1 xs0123456789876543210 ys0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 xs0123456789876543210) ys0123456789876543210 = Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 + where + Lambda_0123456789876543210Sym2KindInference :: forall xs0123456789876543210 + ys0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210) arg) (Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 arg) => + Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 + type Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 + type family Lambda_0123456789876543210 a ma mb t where + Lambda_0123456789876543210 a ma mb b = Apply (Apply (>>@#@$) (Apply GuardSym0 b)) (Apply ReturnSym0 a) instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) - data Lambda_0123456789876543210Sym0 xs0123456789876543210 + data Lambda_0123456789876543210Sym0 a0123456789876543210 where - Lambda_0123456789876543210Sym0KindInference :: forall xs0123456789876543210 + Lambda_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 xs0123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 xs0123456789876543210 = Lambda_0123456789876543210Sym1 xs0123456789876543210 - type family Lambda_0123456789876543210 a ma mb t where - Lambda_0123456789876543210 a ma mb b = Apply (Apply (>>@#@$) (Apply GuardSym0 b)) (Apply ReturnSym0 a) - type Lambda_0123456789876543210Sym4 a0123456789876543210 ma0123456789876543210 mb0123456789876543210 t0123456789876543210 = - Lambda_0123456789876543210 a0123456789876543210 ma0123456789876543210 mb0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 mb0123456789876543210 ma0123456789876543210 a0123456789876543210) where + Lambda_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 a0123456789876543210 = Lambda_0123456789876543210Sym1 a0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) - data Lambda_0123456789876543210Sym3 a0123456789876543210 ma0123456789876543210 mb0123456789876543210 t0123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) + data Lambda_0123456789876543210Sym1 a0123456789876543210 ma0123456789876543210 where - Lambda_0123456789876543210Sym3KindInference :: forall a0123456789876543210 + Lambda_0123456789876543210Sym1KindInference :: forall a0123456789876543210 ma0123456789876543210 - mb0123456789876543210 - t0123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym3 a0123456789876543210 ma0123456789876543210 mb0123456789876543210) arg) (Lambda_0123456789876543210Sym4 a0123456789876543210 ma0123456789876543210 mb0123456789876543210 arg) => - Lambda_0123456789876543210Sym3 a0123456789876543210 ma0123456789876543210 mb0123456789876543210 t0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym3 mb0123456789876543210 ma0123456789876543210 a0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym4 mb0123456789876543210 ma0123456789876543210 a0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 ma0123456789876543210 a0123456789876543210) where + arg. SameKind (Apply (Lambda_0123456789876543210Sym1 a0123456789876543210) arg) (Lambda_0123456789876543210Sym2 a0123456789876543210 arg) => + Lambda_0123456789876543210Sym1 a0123456789876543210 ma0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym1 a0123456789876543210) ma0123456789876543210 = Lambda_0123456789876543210Sym2 a0123456789876543210 ma0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 a0123456789876543210 ma0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) data Lambda_0123456789876543210Sym2 a0123456789876543210 ma0123456789876543210 mb0123456789876543210 @@ -259,41 +264,32 @@ Singletons/T184.hs:(0,0)-(0,0): Splicing declarations mb0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym2 a0123456789876543210 ma0123456789876543210) arg) (Lambda_0123456789876543210Sym3 a0123456789876543210 ma0123456789876543210 arg) => Lambda_0123456789876543210Sym2 a0123456789876543210 ma0123456789876543210 mb0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 ma0123456789876543210 a0123456789876543210) mb0123456789876543210 = Lambda_0123456789876543210Sym3 ma0123456789876543210 a0123456789876543210 mb0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 a0123456789876543210) where + type instance Apply (Lambda_0123456789876543210Sym2 a0123456789876543210 ma0123456789876543210) mb0123456789876543210 = Lambda_0123456789876543210Sym3 a0123456789876543210 ma0123456789876543210 mb0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 a0123456789876543210 ma0123456789876543210 mb0123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) - data Lambda_0123456789876543210Sym1 a0123456789876543210 ma0123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) + data Lambda_0123456789876543210Sym3 a0123456789876543210 ma0123456789876543210 mb0123456789876543210 t0123456789876543210 where - Lambda_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + Lambda_0123456789876543210Sym3KindInference :: forall a0123456789876543210 ma0123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym1 a0123456789876543210) arg) (Lambda_0123456789876543210Sym2 a0123456789876543210 arg) => - Lambda_0123456789876543210Sym1 a0123456789876543210 ma0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym1 a0123456789876543210) ma0123456789876543210 = Lambda_0123456789876543210Sym2 a0123456789876543210 ma0123456789876543210 + mb0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym3 a0123456789876543210 ma0123456789876543210 mb0123456789876543210) arg) (Lambda_0123456789876543210Sym4 a0123456789876543210 ma0123456789876543210 mb0123456789876543210 arg) => + Lambda_0123456789876543210Sym3 a0123456789876543210 ma0123456789876543210 mb0123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym3 a0123456789876543210 ma0123456789876543210 mb0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym4 a0123456789876543210 ma0123456789876543210 mb0123456789876543210 t0123456789876543210 + type Lambda_0123456789876543210Sym4 a0123456789876543210 ma0123456789876543210 mb0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 a0123456789876543210 ma0123456789876543210 mb0123456789876543210 t0123456789876543210 + type family Lambda_0123456789876543210 ma mb t where + Lambda_0123456789876543210 ma mb a = Apply (Apply (>>=@#@$) mb) (Apply (Apply (Apply Lambda_0123456789876543210Sym0 a) ma) mb) instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) - data Lambda_0123456789876543210Sym0 a0123456789876543210 + data Lambda_0123456789876543210Sym0 ma0123456789876543210 where - Lambda_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + Lambda_0123456789876543210Sym0KindInference :: forall ma0123456789876543210 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 ma mb t where - Lambda_0123456789876543210 ma mb a = Apply (Apply (>>=@#@$) mb) (Apply (Apply (Apply Lambda_0123456789876543210Sym0 a) ma) mb) - type Lambda_0123456789876543210Sym3 ma0123456789876543210 mb0123456789876543210 t0123456789876543210 = - Lambda_0123456789876543210 ma0123456789876543210 mb0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 mb0123456789876543210 ma0123456789876543210) where - suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) - data Lambda_0123456789876543210Sym2 ma0123456789876543210 mb0123456789876543210 t0123456789876543210 - where - Lambda_0123456789876543210Sym2KindInference :: forall ma0123456789876543210 - mb0123456789876543210 - t0123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym2 ma0123456789876543210 mb0123456789876543210) arg) (Lambda_0123456789876543210Sym3 ma0123456789876543210 mb0123456789876543210 arg) => - Lambda_0123456789876543210Sym2 ma0123456789876543210 mb0123456789876543210 t0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 mb0123456789876543210 ma0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym3 mb0123456789876543210 ma0123456789876543210 t0123456789876543210 + Lambda_0123456789876543210Sym0 ma0123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 ma0123456789876543210 = Lambda_0123456789876543210Sym1 ma0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 ma0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) @@ -304,17 +300,19 @@ Singletons/T184.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Lambda_0123456789876543210Sym1 ma0123456789876543210) arg) (Lambda_0123456789876543210Sym2 ma0123456789876543210 arg) => Lambda_0123456789876543210Sym1 ma0123456789876543210 mb0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 ma0123456789876543210) mb0123456789876543210 = Lambda_0123456789876543210Sym2 ma0123456789876543210 mb0123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 ma0123456789876543210 mb0123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) - data Lambda_0123456789876543210Sym0 ma0123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 ma0123456789876543210 mb0123456789876543210 t0123456789876543210 where - Lambda_0123456789876543210Sym0KindInference :: forall ma0123456789876543210 - arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 ma0123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 ma0123456789876543210 = Lambda_0123456789876543210Sym1 ma0123456789876543210 - type TruesSym1 (a0123456789876543210 :: [Bool]) = - Trues a0123456789876543210 + Lambda_0123456789876543210Sym2KindInference :: forall ma0123456789876543210 + mb0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym2 ma0123456789876543210 mb0123456789876543210) arg) (Lambda_0123456789876543210Sym3 ma0123456789876543210 mb0123456789876543210 arg) => + Lambda_0123456789876543210Sym2 ma0123456789876543210 mb0123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 ma0123456789876543210 mb0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym3 ma0123456789876543210 mb0123456789876543210 t0123456789876543210 + type Lambda_0123456789876543210Sym3 ma0123456789876543210 mb0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 ma0123456789876543210 mb0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings TruesSym0 where suppressUnusedWarnings = snd (((,) TruesSym0KindInference) ()) data TruesSym0 :: (~>) [Bool] [Bool] @@ -323,8 +321,19 @@ Singletons/T184.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply TruesSym0 arg) (TruesSym1 arg) => TruesSym0 a0123456789876543210 type instance Apply TruesSym0 a0123456789876543210 = TruesSym1 a0123456789876543210 - type CartProdSym2 (a0123456789876543210 :: [a0123456789876543210]) (a0123456789876543210 :: [b0123456789876543210]) = - CartProd a0123456789876543210 a0123456789876543210 + type TruesSym1 (a0123456789876543210 :: [Bool]) = + Trues a0123456789876543210 + instance SuppressUnusedWarnings CartProdSym0 where + suppressUnusedWarnings = snd (((,) CartProdSym0KindInference) ()) + data CartProdSym0 :: forall a0123456789876543210 + b0123456789876543210. + (~>) [a0123456789876543210] ((~>) [b0123456789876543210] [(a0123456789876543210, + b0123456789876543210)]) + where + CartProdSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply CartProdSym0 arg) (CartProdSym1 arg) => + CartProdSym0 a0123456789876543210 + type instance Apply CartProdSym0 a0123456789876543210 = CartProdSym1 a0123456789876543210 instance SuppressUnusedWarnings (CartProdSym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) CartProdSym1KindInference) ()) data CartProdSym1 (a0123456789876543210 :: [a0123456789876543210]) :: forall b0123456789876543210. @@ -336,19 +345,18 @@ Singletons/T184.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (CartProdSym1 a0123456789876543210) arg) (CartProdSym2 a0123456789876543210 arg) => CartProdSym1 a0123456789876543210 a0123456789876543210 type instance Apply (CartProdSym1 a0123456789876543210) a0123456789876543210 = CartProdSym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings CartProdSym0 where - suppressUnusedWarnings = snd (((,) CartProdSym0KindInference) ()) - data CartProdSym0 :: forall a0123456789876543210 - b0123456789876543210. - (~>) [a0123456789876543210] ((~>) [b0123456789876543210] [(a0123456789876543210, - b0123456789876543210)]) + type CartProdSym2 (a0123456789876543210 :: [a0123456789876543210]) (a0123456789876543210 :: [b0123456789876543210]) = + CartProd a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Zip'Sym0 where + suppressUnusedWarnings = snd (((,) Zip'Sym0KindInference) ()) + data Zip'Sym0 :: forall a0123456789876543210 b0123456789876543210. + (~>) [a0123456789876543210] ((~>) [b0123456789876543210] [(a0123456789876543210, + b0123456789876543210)]) where - CartProdSym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply CartProdSym0 arg) (CartProdSym1 arg) => - CartProdSym0 a0123456789876543210 - type instance Apply CartProdSym0 a0123456789876543210 = CartProdSym1 a0123456789876543210 - type Zip'Sym2 (a0123456789876543210 :: [a0123456789876543210]) (a0123456789876543210 :: [b0123456789876543210]) = - Zip' a0123456789876543210 a0123456789876543210 + Zip'Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Zip'Sym0 arg) (Zip'Sym1 arg) => + Zip'Sym0 a0123456789876543210 + type instance Apply Zip'Sym0 a0123456789876543210 = Zip'Sym1 a0123456789876543210 instance SuppressUnusedWarnings (Zip'Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Zip'Sym1KindInference) ()) data Zip'Sym1 (a0123456789876543210 :: [a0123456789876543210]) :: forall b0123456789876543210. @@ -360,18 +368,17 @@ Singletons/T184.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Zip'Sym1 a0123456789876543210) arg) (Zip'Sym2 a0123456789876543210 arg) => Zip'Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Zip'Sym1 a0123456789876543210) a0123456789876543210 = Zip'Sym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings Zip'Sym0 where - suppressUnusedWarnings = snd (((,) Zip'Sym0KindInference) ()) - data Zip'Sym0 :: forall a0123456789876543210 b0123456789876543210. - (~>) [a0123456789876543210] ((~>) [b0123456789876543210] [(a0123456789876543210, - b0123456789876543210)]) + type Zip'Sym2 (a0123456789876543210 :: [a0123456789876543210]) (a0123456789876543210 :: [b0123456789876543210]) = + Zip' a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings BoogieSym0 where + suppressUnusedWarnings = snd (((,) BoogieSym0KindInference) ()) + data BoogieSym0 :: forall a0123456789876543210. + (~>) (Maybe a0123456789876543210) ((~>) (Maybe Bool) (Maybe a0123456789876543210)) where - Zip'Sym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply Zip'Sym0 arg) (Zip'Sym1 arg) => - Zip'Sym0 a0123456789876543210 - type instance Apply Zip'Sym0 a0123456789876543210 = Zip'Sym1 a0123456789876543210 - type BoogieSym2 (a0123456789876543210 :: Maybe a0123456789876543210) (a0123456789876543210 :: Maybe Bool) = - Boogie a0123456789876543210 a0123456789876543210 + BoogieSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply BoogieSym0 arg) (BoogieSym1 arg) => + BoogieSym0 a0123456789876543210 + type instance Apply BoogieSym0 a0123456789876543210 = BoogieSym1 a0123456789876543210 instance SuppressUnusedWarnings (BoogieSym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) BoogieSym1KindInference) ()) data BoogieSym1 (a0123456789876543210 :: Maybe a0123456789876543210) :: (~>) (Maybe Bool) (Maybe a0123456789876543210) @@ -381,15 +388,8 @@ Singletons/T184.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (BoogieSym1 a0123456789876543210) arg) (BoogieSym2 a0123456789876543210 arg) => BoogieSym1 a0123456789876543210 a0123456789876543210 type instance Apply (BoogieSym1 a0123456789876543210) a0123456789876543210 = BoogieSym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings BoogieSym0 where - suppressUnusedWarnings = snd (((,) BoogieSym0KindInference) ()) - data BoogieSym0 :: forall a0123456789876543210. - (~>) (Maybe a0123456789876543210) ((~>) (Maybe Bool) (Maybe a0123456789876543210)) - where - BoogieSym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply BoogieSym0 arg) (BoogieSym1 arg) => - BoogieSym0 a0123456789876543210 - type instance Apply BoogieSym0 a0123456789876543210 = BoogieSym1 a0123456789876543210 + type BoogieSym2 (a0123456789876543210 :: Maybe a0123456789876543210) (a0123456789876543210 :: Maybe Bool) = + Boogie a0123456789876543210 a0123456789876543210 type family Trues (a :: [Bool]) :: [Bool] where Trues xs = Apply (Apply (>>=@#@$) xs) (Apply Lambda_0123456789876543210Sym0 xs) type family CartProd (a :: [a]) (a :: [b]) :: [(a, b)] where diff --git a/tests/compile-and-dump/Singletons/T187.golden b/tests/compile-and-dump/Singletons/T187.golden index c76c4fb7..f71455cb 100644 --- a/tests/compile-and-dump/Singletons/T187.golden +++ b/tests/compile-and-dump/Singletons/T187.golden @@ -10,8 +10,15 @@ Singletons/T187.hs:(0,0)-(0,0): Splicing declarations deriving instance Ord Empty type family Compare_0123456789876543210 (a :: Empty) (a :: Empty) :: Ordering where Compare_0123456789876543210 _ _ = EQSym0 - type Compare_0123456789876543210Sym2 (a0123456789876543210 :: Empty) (a0123456789876543210 :: Empty) = - Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Compare_0123456789876543210Sym0KindInference) ()) + data Compare_0123456789876543210Sym0 :: (~>) Empty ((~>) Empty Ordering) + where + Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => + Compare_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 instance SuppressUnusedWarnings (Compare_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Compare_0123456789876543210Sym1KindInference) ()) @@ -22,15 +29,8 @@ Singletons/T187.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Compare_0123456789876543210Sym1 a0123456789876543210) arg) (Compare_0123456789876543210Sym2 a0123456789876543210 arg) => Compare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Compare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Compare_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd (((,) Compare_0123456789876543210Sym0KindInference) ()) - data Compare_0123456789876543210Sym0 :: (~>) Empty ((~>) Empty Ordering) - where - Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => - Compare_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 + type Compare_0123456789876543210Sym2 (a0123456789876543210 :: Empty) (a0123456789876543210 :: Empty) = + Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance POrd Empty where type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a type family Equals_0123456789876543210 (a :: Empty) (b :: Empty) :: Bool where diff --git a/tests/compile-and-dump/Singletons/T190.golden b/tests/compile-and-dump/Singletons/T190.golden index 2e355088..4e535430 100644 --- a/tests/compile-and-dump/Singletons/T190.golden +++ b/tests/compile-and-dump/Singletons/T190.golden @@ -10,8 +10,15 @@ Singletons/T190.hs:0:0:: Splicing declarations type TSym0 = T type family Compare_0123456789876543210 (a :: T) (a :: T) :: Ordering where Compare_0123456789876543210 T T = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] - type Compare_0123456789876543210Sym2 (a0123456789876543210 :: T) (a0123456789876543210 :: T) = - Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Compare_0123456789876543210Sym0KindInference) ()) + data Compare_0123456789876543210Sym0 :: (~>) T ((~>) T Ordering) + where + Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => + Compare_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 instance SuppressUnusedWarnings (Compare_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Compare_0123456789876543210Sym1KindInference) ()) @@ -22,15 +29,8 @@ Singletons/T190.hs:0:0:: Splicing declarations arg. SameKind (Apply (Compare_0123456789876543210Sym1 a0123456789876543210) arg) (Compare_0123456789876543210Sym2 a0123456789876543210 arg) => Compare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Compare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Compare_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd (((,) Compare_0123456789876543210Sym0KindInference) ()) - data Compare_0123456789876543210Sym0 :: (~>) T ((~>) T Ordering) - where - Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => - Compare_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 + type Compare_0123456789876543210Sym2 (a0123456789876543210 :: T) (a0123456789876543210 :: T) = + Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance POrd T where type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a type family Case_0123456789876543210 n t where @@ -38,8 +38,6 @@ Singletons/T190.hs:0:0:: Splicing declarations Case_0123456789876543210 n 'False = Apply ErrorSym0 "toEnum: bad argument" type family ToEnum_0123456789876543210 (a :: GHC.Types.Nat) :: T where ToEnum_0123456789876543210 n = Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 0)) - type ToEnum_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) = - ToEnum_0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings ToEnum_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) ToEnum_0123456789876543210Sym0KindInference) ()) @@ -49,10 +47,10 @@ Singletons/T190.hs:0:0:: Splicing declarations arg. SameKind (Apply ToEnum_0123456789876543210Sym0 arg) (ToEnum_0123456789876543210Sym1 arg) => ToEnum_0123456789876543210Sym0 a0123456789876543210 type instance Apply ToEnum_0123456789876543210Sym0 a0123456789876543210 = ToEnum_0123456789876543210Sym1 a0123456789876543210 + type ToEnum_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) = + ToEnum_0123456789876543210 a0123456789876543210 type family FromEnum_0123456789876543210 (a :: T) :: GHC.Types.Nat where FromEnum_0123456789876543210 T = Data.Singletons.Prelude.Num.FromInteger 0 - type FromEnum_0123456789876543210Sym1 (a0123456789876543210 :: T) = - FromEnum_0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings FromEnum_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) FromEnum_0123456789876543210Sym0KindInference) ()) @@ -62,6 +60,8 @@ Singletons/T190.hs:0:0:: Splicing declarations arg. SameKind (Apply FromEnum_0123456789876543210Sym0 arg) (FromEnum_0123456789876543210Sym1 arg) => FromEnum_0123456789876543210Sym0 a0123456789876543210 type instance Apply FromEnum_0123456789876543210Sym0 a0123456789876543210 = FromEnum_0123456789876543210Sym1 a0123456789876543210 + type FromEnum_0123456789876543210Sym1 (a0123456789876543210 :: T) = + FromEnum_0123456789876543210 a0123456789876543210 instance PEnum T where type ToEnum a = Apply ToEnum_0123456789876543210Sym0 a type FromEnum a = Apply FromEnum_0123456789876543210Sym0 a @@ -78,19 +78,15 @@ Singletons/T190.hs:0:0:: Splicing declarations type MaxBound = MaxBound_0123456789876543210Sym0 type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: T) (a :: GHC.Types.Symbol) :: GHC.Types.Symbol where ShowsPrec_0123456789876543210 _ T a_0123456789876543210 = Apply (Apply ShowStringSym0 "T") a_0123456789876543210 - type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: T) (a0123456789876543210 :: GHC.Types.Symbol) = - ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where suppressUnusedWarnings - = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) - data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: T) :: (~>) GHC.Types.Symbol GHC.Types.Symbol + = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) + data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Types.Nat ((~>) T ((~>) GHC.Types.Symbol GHC.Types.Symbol)) where - ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 - a0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => - ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 - type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 + ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => + ShowsPrec_0123456789876543210Sym0 a0123456789876543210 + type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ()) @@ -101,15 +97,19 @@ Singletons/T190.hs:0:0:: Splicing declarations arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) => ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where + instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where suppressUnusedWarnings - = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) - data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Types.Nat ((~>) T ((~>) GHC.Types.Symbol GHC.Types.Symbol)) + = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) + data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: T) :: (~>) GHC.Types.Symbol GHC.Types.Symbol where - ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => - ShowsPrec_0123456789876543210Sym0 a0123456789876543210 - type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 + ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 + a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => + ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: T) (a0123456789876543210 :: GHC.Types.Symbol) = + ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance PShow T where type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a type family Equals_0123456789876543210 (a :: T) (b :: T) :: Bool where diff --git a/tests/compile-and-dump/Singletons/T197.golden b/tests/compile-and-dump/Singletons/T197.golden index 442b1bca..99c56424 100644 --- a/tests/compile-and-dump/Singletons/T197.golden +++ b/tests/compile-and-dump/Singletons/T197.golden @@ -8,9 +8,15 @@ Singletons/T197.hs:(0,0)-(0,0): Splicing declarations infixl 5 $$: ($$:) :: Bool -> Bool -> Bool ($$:) _ _ = False - type ($$:@#@$$$) (a0123456789876543210 :: Bool) (a0123456789876543210 :: Bool) = - ($$:) a0123456789876543210 a0123456789876543210 - infixl 5 $$:@#@$$$ + instance SuppressUnusedWarnings ($$:@#@$) where + suppressUnusedWarnings = snd (((,) (:$$:@#@$###)) ()) + data ($$:@#@$) :: (~>) Bool ((~>) Bool Bool) + where + (:$$:@#@$###) :: forall a0123456789876543210 + arg. SameKind (Apply ($$:@#@$) arg) (($$:@#@$$) arg) => + ($$:@#@$) a0123456789876543210 + type instance Apply ($$:@#@$) a0123456789876543210 = ($$:@#@$$) a0123456789876543210 + infixl 5 $$:@#@$ instance SuppressUnusedWarnings (($$:@#@$$) a0123456789876543210) where suppressUnusedWarnings = snd (((,) (:$$:@#@$$###)) ()) data ($$:@#@$$) (a0123456789876543210 :: Bool) :: (~>) Bool Bool @@ -21,15 +27,9 @@ Singletons/T197.hs:(0,0)-(0,0): Splicing declarations ($$:@#@$$) a0123456789876543210 a0123456789876543210 type instance Apply (($$:@#@$$) a0123456789876543210) a0123456789876543210 = ($$:@#@$$$) a0123456789876543210 a0123456789876543210 infixl 5 $$:@#@$$ - instance SuppressUnusedWarnings ($$:@#@$) where - suppressUnusedWarnings = snd (((,) (:$$:@#@$###)) ()) - data ($$:@#@$) :: (~>) Bool ((~>) Bool Bool) - where - (:$$:@#@$###) :: forall a0123456789876543210 - arg. SameKind (Apply ($$:@#@$) arg) (($$:@#@$$) arg) => - ($$:@#@$) a0123456789876543210 - type instance Apply ($$:@#@$) a0123456789876543210 = ($$:@#@$$) a0123456789876543210 - infixl 5 $$:@#@$ + type ($$:@#@$$$) (a0123456789876543210 :: Bool) (a0123456789876543210 :: Bool) = + ($$:) a0123456789876543210 a0123456789876543210 + infixl 5 $$:@#@$$$ type family ($$:) (a :: Bool) (a :: Bool) :: Bool where ($$:) _ _ = FalseSym0 infixl 5 %$$: diff --git a/tests/compile-and-dump/Singletons/T197b.golden b/tests/compile-and-dump/Singletons/T197b.golden index c735918d..688b90c2 100644 --- a/tests/compile-and-dump/Singletons/T197b.golden +++ b/tests/compile-and-dump/Singletons/T197b.golden @@ -9,8 +9,15 @@ Singletons/T197b.hs:(0,0)-(0,0): Splicing declarations data Pair a b = MkPair a b infixr 9 `Pair` infixr 9 `MkPair` - type (:*:@#@$$$) (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) = - (:*:) t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (:*:@#@$) where + suppressUnusedWarnings = snd (((,) (::*:@#@$###)) ()) + data (:*:@#@$) :: forall a0123456789876543210 b0123456789876543210. + (~>) a0123456789876543210 ((~>) b0123456789876543210 ((:*:) a0123456789876543210 b0123456789876543210)) + where + (::*:@#@$###) :: forall t0123456789876543210 + arg. SameKind (Apply (:*:@#@$) arg) ((:*:@#@$$) arg) => + (:*:@#@$) t0123456789876543210 + type instance Apply (:*:@#@$) t0123456789876543210 = (:*:@#@$$) t0123456789876543210 instance SuppressUnusedWarnings ((:*:@#@$$) t0123456789876543210) where suppressUnusedWarnings = snd (((,) (::*:@#@$$###)) ()) data (:*:@#@$$) (t0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. @@ -21,18 +28,19 @@ Singletons/T197b.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply ((:*:@#@$$) t0123456789876543210) arg) ((:*:@#@$$$) t0123456789876543210 arg) => (:*:@#@$$) t0123456789876543210 t0123456789876543210 type instance Apply ((:*:@#@$$) t0123456789876543210) t0123456789876543210 = (:*:@#@$$$) t0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (:*:@#@$) where - suppressUnusedWarnings = snd (((,) (::*:@#@$###)) ()) - data (:*:@#@$) :: forall a0123456789876543210 b0123456789876543210. - (~>) a0123456789876543210 ((~>) b0123456789876543210 ((:*:) a0123456789876543210 b0123456789876543210)) + type (:*:@#@$$$) (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) = + (:*:) t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings MkPairSym0 where + suppressUnusedWarnings = snd (((,) MkPairSym0KindInference) ()) + data MkPairSym0 :: forall a0123456789876543210 + b0123456789876543210. + (~>) a0123456789876543210 ((~>) b0123456789876543210 (Pair a0123456789876543210 b0123456789876543210)) where - (::*:@#@$###) :: forall t0123456789876543210 - arg. SameKind (Apply (:*:@#@$) arg) ((:*:@#@$$) arg) => - (:*:@#@$) t0123456789876543210 - type instance Apply (:*:@#@$) t0123456789876543210 = (:*:@#@$$) t0123456789876543210 - type MkPairSym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) = - MkPair t0123456789876543210 t0123456789876543210 - infixr 9 `MkPairSym2` + MkPairSym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply MkPairSym0 arg) (MkPairSym1 arg) => + MkPairSym0 t0123456789876543210 + type instance Apply MkPairSym0 t0123456789876543210 = MkPairSym1 t0123456789876543210 + infixr 9 `MkPairSym0` instance SuppressUnusedWarnings (MkPairSym1 t0123456789876543210) where suppressUnusedWarnings = snd (((,) MkPairSym1KindInference) ()) data MkPairSym1 (t0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. @@ -44,17 +52,9 @@ Singletons/T197b.hs:(0,0)-(0,0): Splicing declarations MkPairSym1 t0123456789876543210 t0123456789876543210 type instance Apply (MkPairSym1 t0123456789876543210) t0123456789876543210 = MkPairSym2 t0123456789876543210 t0123456789876543210 infixr 9 `MkPairSym1` - instance SuppressUnusedWarnings MkPairSym0 where - suppressUnusedWarnings = snd (((,) MkPairSym0KindInference) ()) - data MkPairSym0 :: forall a0123456789876543210 - b0123456789876543210. - (~>) a0123456789876543210 ((~>) b0123456789876543210 (Pair a0123456789876543210 b0123456789876543210)) - where - MkPairSym0KindInference :: forall t0123456789876543210 - arg. SameKind (Apply MkPairSym0 arg) (MkPairSym1 arg) => - MkPairSym0 t0123456789876543210 - type instance Apply MkPairSym0 t0123456789876543210 = MkPairSym1 t0123456789876543210 - infixr 9 `MkPairSym0` + type MkPairSym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) = + MkPair t0123456789876543210 t0123456789876543210 + infixr 9 `MkPairSym2` infixr 9 `SMkPair` data (%:*:) :: forall a b. (:*:) a b -> GHC.Types.Type where diff --git a/tests/compile-and-dump/Singletons/T200.golden b/tests/compile-and-dump/Singletons/T200.golden index 93a8f815..9b4b6d25 100644 --- a/tests/compile-and-dump/Singletons/T200.golden +++ b/tests/compile-and-dump/Singletons/T200.golden @@ -18,8 +18,14 @@ Singletons/T200.hs:(0,0)-(0,0): Splicing declarations ($$:) x y = (x :$$: y) (<>:) :: ErrorMessage -> ErrorMessage -> ErrorMessage (<>:) x y = (x :<>: y) - type (:$$:@#@$$$) (t0123456789876543210 :: ErrorMessage) (t0123456789876543210 :: ErrorMessage) = - (:$$:) t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (:$$:@#@$) where + suppressUnusedWarnings = snd (((,) (::$$:@#@$###)) ()) + data (:$$:@#@$) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage) + where + (::$$:@#@$###) :: forall t0123456789876543210 + arg. SameKind (Apply (:$$:@#@$) arg) ((:$$:@#@$$) arg) => + (:$$:@#@$) t0123456789876543210 + type instance Apply (:$$:@#@$) t0123456789876543210 = (:$$:@#@$$) t0123456789876543210 instance SuppressUnusedWarnings ((:$$:@#@$$) t0123456789876543210) where suppressUnusedWarnings = snd (((,) (::$$:@#@$$###)) ()) data (:$$:@#@$$) (t0123456789876543210 :: ErrorMessage) :: (~>) ErrorMessage ErrorMessage @@ -29,16 +35,16 @@ Singletons/T200.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply ((:$$:@#@$$) t0123456789876543210) arg) ((:$$:@#@$$$) t0123456789876543210 arg) => (:$$:@#@$$) t0123456789876543210 t0123456789876543210 type instance Apply ((:$$:@#@$$) t0123456789876543210) t0123456789876543210 = (:$$:@#@$$$) t0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (:$$:@#@$) where - suppressUnusedWarnings = snd (((,) (::$$:@#@$###)) ()) - data (:$$:@#@$) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage) + type (:$$:@#@$$$) (t0123456789876543210 :: ErrorMessage) (t0123456789876543210 :: ErrorMessage) = + (:$$:) t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (:<>:@#@$) where + suppressUnusedWarnings = snd (((,) (::<>:@#@$###)) ()) + data (:<>:@#@$) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage) where - (::$$:@#@$###) :: forall t0123456789876543210 - arg. SameKind (Apply (:$$:@#@$) arg) ((:$$:@#@$$) arg) => - (:$$:@#@$) t0123456789876543210 - type instance Apply (:$$:@#@$) t0123456789876543210 = (:$$:@#@$$) t0123456789876543210 - type (:<>:@#@$$$) (t0123456789876543210 :: ErrorMessage) (t0123456789876543210 :: ErrorMessage) = - (:<>:) t0123456789876543210 t0123456789876543210 + (::<>:@#@$###) :: forall t0123456789876543210 + arg. SameKind (Apply (:<>:@#@$) arg) ((:<>:@#@$$) arg) => + (:<>:@#@$) t0123456789876543210 + type instance Apply (:<>:@#@$) t0123456789876543210 = (:<>:@#@$$) t0123456789876543210 instance SuppressUnusedWarnings ((:<>:@#@$$) t0123456789876543210) where suppressUnusedWarnings = snd (((,) (::<>:@#@$$###)) ()) data (:<>:@#@$$) (t0123456789876543210 :: ErrorMessage) :: (~>) ErrorMessage ErrorMessage @@ -48,16 +54,8 @@ Singletons/T200.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply ((:<>:@#@$$) t0123456789876543210) arg) ((:<>:@#@$$$) t0123456789876543210 arg) => (:<>:@#@$$) t0123456789876543210 t0123456789876543210 type instance Apply ((:<>:@#@$$) t0123456789876543210) t0123456789876543210 = (:<>:@#@$$$) t0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (:<>:@#@$) where - suppressUnusedWarnings = snd (((,) (::<>:@#@$###)) ()) - data (:<>:@#@$) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage) - where - (::<>:@#@$###) :: forall t0123456789876543210 - arg. SameKind (Apply (:<>:@#@$) arg) ((:<>:@#@$$) arg) => - (:<>:@#@$) t0123456789876543210 - type instance Apply (:<>:@#@$) t0123456789876543210 = (:<>:@#@$$) t0123456789876543210 - type EMSym1 (t0123456789876543210 :: [Bool]) = - EM t0123456789876543210 + type (:<>:@#@$$$) (t0123456789876543210 :: ErrorMessage) (t0123456789876543210 :: ErrorMessage) = + (:<>:) t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings EMSym0 where suppressUnusedWarnings = snd (((,) EMSym0KindInference) ()) data EMSym0 :: (~>) [Bool] ErrorMessage @@ -66,8 +64,16 @@ Singletons/T200.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply EMSym0 arg) (EMSym1 arg) => EMSym0 t0123456789876543210 type instance Apply EMSym0 t0123456789876543210 = EMSym1 t0123456789876543210 - type (<>:@#@$$$) (a0123456789876543210 :: ErrorMessage) (a0123456789876543210 :: ErrorMessage) = - (<>:) a0123456789876543210 a0123456789876543210 + type EMSym1 (t0123456789876543210 :: [Bool]) = + EM t0123456789876543210 + instance SuppressUnusedWarnings (<>:@#@$) where + suppressUnusedWarnings = snd (((,) (:<>:@#@$###)) ()) + data (<>:@#@$) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage) + where + (:<>:@#@$###) :: forall a0123456789876543210 + arg. SameKind (Apply (<>:@#@$) arg) ((<>:@#@$$) arg) => + (<>:@#@$) a0123456789876543210 + type instance Apply (<>:@#@$) a0123456789876543210 = (<>:@#@$$) a0123456789876543210 instance SuppressUnusedWarnings ((<>:@#@$$) a0123456789876543210) where suppressUnusedWarnings = snd (((,) (:<>:@#@$$###)) ()) data (<>:@#@$$) (a0123456789876543210 :: ErrorMessage) :: (~>) ErrorMessage ErrorMessage @@ -77,16 +83,16 @@ Singletons/T200.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply ((<>:@#@$$) a0123456789876543210) arg) ((<>:@#@$$$) a0123456789876543210 arg) => (<>:@#@$$) a0123456789876543210 a0123456789876543210 type instance Apply ((<>:@#@$$) a0123456789876543210) a0123456789876543210 = (<>:@#@$$$) a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (<>:@#@$) where - suppressUnusedWarnings = snd (((,) (:<>:@#@$###)) ()) - data (<>:@#@$) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage) + type (<>:@#@$$$) (a0123456789876543210 :: ErrorMessage) (a0123456789876543210 :: ErrorMessage) = + (<>:) a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings ($$:@#@$) where + suppressUnusedWarnings = snd (((,) (:$$:@#@$###)) ()) + data ($$:@#@$) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage) where - (:<>:@#@$###) :: forall a0123456789876543210 - arg. SameKind (Apply (<>:@#@$) arg) ((<>:@#@$$) arg) => - (<>:@#@$) a0123456789876543210 - type instance Apply (<>:@#@$) a0123456789876543210 = (<>:@#@$$) a0123456789876543210 - type ($$:@#@$$$) (a0123456789876543210 :: ErrorMessage) (a0123456789876543210 :: ErrorMessage) = - ($$:) a0123456789876543210 a0123456789876543210 + (:$$:@#@$###) :: forall a0123456789876543210 + arg. SameKind (Apply ($$:@#@$) arg) (($$:@#@$$) arg) => + ($$:@#@$) a0123456789876543210 + type instance Apply ($$:@#@$) a0123456789876543210 = ($$:@#@$$) a0123456789876543210 instance SuppressUnusedWarnings (($$:@#@$$) a0123456789876543210) where suppressUnusedWarnings = snd (((,) (:$$:@#@$$###)) ()) data ($$:@#@$$) (a0123456789876543210 :: ErrorMessage) :: (~>) ErrorMessage ErrorMessage @@ -96,14 +102,8 @@ Singletons/T200.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (($$:@#@$$) a0123456789876543210) arg) (($$:@#@$$$) a0123456789876543210 arg) => ($$:@#@$$) a0123456789876543210 a0123456789876543210 type instance Apply (($$:@#@$$) a0123456789876543210) a0123456789876543210 = ($$:@#@$$$) a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ($$:@#@$) where - suppressUnusedWarnings = snd (((,) (:$$:@#@$###)) ()) - data ($$:@#@$) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage) - where - (:$$:@#@$###) :: forall a0123456789876543210 - arg. SameKind (Apply ($$:@#@$) arg) (($$:@#@$$) arg) => - ($$:@#@$) a0123456789876543210 - type instance Apply ($$:@#@$) a0123456789876543210 = ($$:@#@$$) a0123456789876543210 + type ($$:@#@$$$) (a0123456789876543210 :: ErrorMessage) (a0123456789876543210 :: ErrorMessage) = + ($$:) a0123456789876543210 a0123456789876543210 type family (<>:) (a :: ErrorMessage) (a :: ErrorMessage) :: ErrorMessage where (<>:) x y = Apply (Apply (:<>:@#@$) x) y type family ($$:) (a :: ErrorMessage) (a :: ErrorMessage) :: ErrorMessage where diff --git a/tests/compile-and-dump/Singletons/T209.golden b/tests/compile-and-dump/Singletons/T209.golden index d687a86b..efa7d497 100644 --- a/tests/compile-and-dump/Singletons/T209.golden +++ b/tests/compile-and-dump/Singletons/T209.golden @@ -18,18 +18,15 @@ Singletons/T209.hs:(0,0)-(0,0): Splicing declarations deriving anyclass (C Bool) deriving anyclass instance C a a => C a (Maybe a) type HmSym0 = Hm - type MSym3 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) (a0123456789876543210 :: Bool) = - M a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (MSym2 a0123456789876543210 a0123456789876543210) where - suppressUnusedWarnings = snd (((,) MSym2KindInference) ()) - data MSym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) :: (~>) Bool Bool + instance SuppressUnusedWarnings MSym0 where + suppressUnusedWarnings = snd (((,) MSym0KindInference) ()) + data MSym0 :: forall a0123456789876543210 b0123456789876543210. + (~>) a0123456789876543210 ((~>) b0123456789876543210 ((~>) Bool Bool)) where - MSym2KindInference :: forall a0123456789876543210 - a0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply (MSym2 a0123456789876543210 a0123456789876543210) arg) (MSym3 a0123456789876543210 a0123456789876543210 arg) => - MSym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 - type instance Apply (MSym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = MSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 + MSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply MSym0 arg) (MSym1 arg) => + MSym0 a0123456789876543210 + type instance Apply MSym0 a0123456789876543210 = MSym1 a0123456789876543210 instance SuppressUnusedWarnings (MSym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) MSym1KindInference) ()) data MSym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. @@ -40,15 +37,18 @@ Singletons/T209.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (MSym1 a0123456789876543210) arg) (MSym2 a0123456789876543210 arg) => MSym1 a0123456789876543210 a0123456789876543210 type instance Apply (MSym1 a0123456789876543210) a0123456789876543210 = MSym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings MSym0 where - suppressUnusedWarnings = snd (((,) MSym0KindInference) ()) - data MSym0 :: forall a0123456789876543210 b0123456789876543210. - (~>) a0123456789876543210 ((~>) b0123456789876543210 ((~>) Bool Bool)) + instance SuppressUnusedWarnings (MSym2 a0123456789876543210 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) MSym2KindInference) ()) + data MSym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) :: (~>) Bool Bool where - MSym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply MSym0 arg) (MSym1 arg) => - MSym0 a0123456789876543210 - type instance Apply MSym0 a0123456789876543210 = MSym1 a0123456789876543210 + MSym2KindInference :: forall a0123456789876543210 + a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (MSym2 a0123456789876543210 a0123456789876543210) arg) (MSym3 a0123456789876543210 a0123456789876543210 arg) => + MSym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type instance Apply (MSym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = MSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type MSym3 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) (a0123456789876543210 :: Bool) = + M a0123456789876543210 a0123456789876543210 a0123456789876543210 type family M (a :: a) (a :: b) (a :: Bool) :: Bool where M _ _ x = x class PC a b diff --git a/tests/compile-and-dump/Singletons/T216.golden b/tests/compile-and-dump/Singletons/T216.golden index ac9042a0..6035b610 100644 --- a/tests/compile-and-dump/Singletons/T216.golden +++ b/tests/compile-and-dump/Singletons/T216.golden @@ -1,17 +1,6 @@ Singletons/T216.hs:0:0:: Splicing declarations genDefunSymbols [''MyProxy, ''Symmetry] ======> - type MyProxySym2 (k0123456789876543210 :: Type) (a0123456789876543210 :: k0123456789876543210) = - MyProxy k0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (MyProxySym1 k0123456789876543210) where - suppressUnusedWarnings = snd (((,) MyProxySym1KindInference) ()) - data MyProxySym1 (k0123456789876543210 :: Type) :: (~>) k0123456789876543210 Type - where - MyProxySym1KindInference :: forall k0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply (MyProxySym1 k0123456789876543210) arg) (MyProxySym2 k0123456789876543210 arg) => - MyProxySym1 k0123456789876543210 a0123456789876543210 - type instance Apply (MyProxySym1 k0123456789876543210) a0123456789876543210 = MyProxySym2 k0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings MyProxySym0 where suppressUnusedWarnings = snd (((,) MyProxySym0KindInference) ()) data MyProxySym0 :: forall (k0123456789876543210 :: Type). @@ -21,28 +10,17 @@ Singletons/T216.hs:0:0:: Splicing declarations arg. SameKind (Apply MyProxySym0 arg) (MyProxySym1 arg) => MyProxySym0 k0123456789876543210 type instance Apply MyProxySym0 k0123456789876543210 = MyProxySym1 k0123456789876543210 - type SymmetrySym3 (a0123456789876543210 :: t0123456789876543210) (y0123456789876543210 :: t0123456789876543210) (e0123456789876543210 :: (:~:) a0123456789876543210 y0123456789876543210) = - Symmetry a0123456789876543210 y0123456789876543210 e0123456789876543210 - instance SuppressUnusedWarnings (SymmetrySym2 y0123456789876543210 a0123456789876543210) where - suppressUnusedWarnings = snd (((,) SymmetrySym2KindInference) ()) - data SymmetrySym2 (a0123456789876543210 :: t0123456789876543210) (y0123456789876543210 :: t0123456789876543210) :: (~>) ((:~:) a0123456789876543210 y0123456789876543210) Type - where - SymmetrySym2KindInference :: forall a0123456789876543210 - y0123456789876543210 - e0123456789876543210 - arg. SameKind (Apply (SymmetrySym2 a0123456789876543210 y0123456789876543210) arg) (SymmetrySym3 a0123456789876543210 y0123456789876543210 arg) => - SymmetrySym2 a0123456789876543210 y0123456789876543210 e0123456789876543210 - type instance Apply (SymmetrySym2 y0123456789876543210 a0123456789876543210) e0123456789876543210 = SymmetrySym3 y0123456789876543210 a0123456789876543210 e0123456789876543210 - instance SuppressUnusedWarnings (SymmetrySym1 a0123456789876543210) where - suppressUnusedWarnings = snd (((,) SymmetrySym1KindInference) ()) - data SymmetrySym1 (a0123456789876543210 :: t0123456789876543210) :: forall (y0123456789876543210 :: t0123456789876543210). - (~>) t0123456789876543210 ((~>) ((:~:) a0123456789876543210 y0123456789876543210) Type) + instance SuppressUnusedWarnings (MyProxySym1 k0123456789876543210) where + suppressUnusedWarnings = snd (((,) MyProxySym1KindInference) ()) + data MyProxySym1 (k0123456789876543210 :: Type) :: (~>) k0123456789876543210 Type where - SymmetrySym1KindInference :: forall a0123456789876543210 - y0123456789876543210 - arg. SameKind (Apply (SymmetrySym1 a0123456789876543210) arg) (SymmetrySym2 a0123456789876543210 arg) => - SymmetrySym1 a0123456789876543210 y0123456789876543210 - type instance Apply (SymmetrySym1 a0123456789876543210) y0123456789876543210 = SymmetrySym2 a0123456789876543210 y0123456789876543210 + MyProxySym1KindInference :: forall k0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (MyProxySym1 k0123456789876543210) arg) (MyProxySym2 k0123456789876543210 arg) => + MyProxySym1 k0123456789876543210 a0123456789876543210 + type instance Apply (MyProxySym1 k0123456789876543210) a0123456789876543210 = MyProxySym2 k0123456789876543210 a0123456789876543210 + type MyProxySym2 (k0123456789876543210 :: Type) (a0123456789876543210 :: k0123456789876543210) = + MyProxy k0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings SymmetrySym0 where suppressUnusedWarnings = snd (((,) SymmetrySym0KindInference) ()) data SymmetrySym0 :: forall t0123456789876543210 @@ -54,3 +32,25 @@ Singletons/T216.hs:0:0:: Splicing declarations arg. SameKind (Apply SymmetrySym0 arg) (SymmetrySym1 arg) => SymmetrySym0 a0123456789876543210 type instance Apply SymmetrySym0 a0123456789876543210 = SymmetrySym1 a0123456789876543210 + instance SuppressUnusedWarnings (SymmetrySym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) SymmetrySym1KindInference) ()) + data SymmetrySym1 (a0123456789876543210 :: t0123456789876543210) :: forall (y0123456789876543210 :: t0123456789876543210). + (~>) t0123456789876543210 ((~>) ((:~:) a0123456789876543210 y0123456789876543210) Type) + where + SymmetrySym1KindInference :: forall a0123456789876543210 + y0123456789876543210 + arg. SameKind (Apply (SymmetrySym1 a0123456789876543210) arg) (SymmetrySym2 a0123456789876543210 arg) => + SymmetrySym1 a0123456789876543210 y0123456789876543210 + type instance Apply (SymmetrySym1 a0123456789876543210) y0123456789876543210 = SymmetrySym2 a0123456789876543210 y0123456789876543210 + instance SuppressUnusedWarnings (SymmetrySym2 a0123456789876543210 y0123456789876543210) where + suppressUnusedWarnings = snd (((,) SymmetrySym2KindInference) ()) + data SymmetrySym2 (a0123456789876543210 :: t0123456789876543210) (y0123456789876543210 :: t0123456789876543210) :: (~>) ((:~:) a0123456789876543210 y0123456789876543210) Type + where + SymmetrySym2KindInference :: forall a0123456789876543210 + y0123456789876543210 + e0123456789876543210 + arg. SameKind (Apply (SymmetrySym2 a0123456789876543210 y0123456789876543210) arg) (SymmetrySym3 a0123456789876543210 y0123456789876543210 arg) => + SymmetrySym2 a0123456789876543210 y0123456789876543210 e0123456789876543210 + type instance Apply (SymmetrySym2 a0123456789876543210 y0123456789876543210) e0123456789876543210 = SymmetrySym3 a0123456789876543210 y0123456789876543210 e0123456789876543210 + type SymmetrySym3 (a0123456789876543210 :: t0123456789876543210) (y0123456789876543210 :: t0123456789876543210) (e0123456789876543210 :: (:~:) a0123456789876543210 y0123456789876543210) = + Symmetry a0123456789876543210 y0123456789876543210 e0123456789876543210 diff --git a/tests/compile-and-dump/Singletons/T229.golden b/tests/compile-and-dump/Singletons/T229.golden index 779f327c..7b08818e 100644 --- a/tests/compile-and-dump/Singletons/T229.golden +++ b/tests/compile-and-dump/Singletons/T229.golden @@ -5,8 +5,6 @@ Singletons/T229.hs:(0,0)-(0,0): Splicing declarations ======> ___foo :: Bool -> Bool ___foo _ = True - type US___fooSym1 (a0123456789876543210 :: Bool) = - US___foo a0123456789876543210 instance SuppressUnusedWarnings US___fooSym0 where suppressUnusedWarnings = snd (((,) US___fooSym0KindInference) ()) data US___fooSym0 :: (~>) Bool Bool @@ -15,6 +13,8 @@ Singletons/T229.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply US___fooSym0 arg) (US___fooSym1 arg) => US___fooSym0 a0123456789876543210 type instance Apply US___fooSym0 a0123456789876543210 = US___fooSym1 a0123456789876543210 + type US___fooSym1 (a0123456789876543210 :: Bool) = + US___foo a0123456789876543210 type family US___foo (a :: Bool) :: Bool where US___foo _ = TrueSym0 ___sfoo :: diff --git a/tests/compile-and-dump/Singletons/T249.golden b/tests/compile-and-dump/Singletons/T249.golden index 66dd777a..35b39bd5 100644 --- a/tests/compile-and-dump/Singletons/T249.golden +++ b/tests/compile-and-dump/Singletons/T249.golden @@ -7,8 +7,6 @@ Singletons/T249.hs:(0,0)-(0,0): Splicing declarations data Foo1 a = MkFoo1 a data Foo2 a where MkFoo2 :: x -> Foo2 x data Foo3 a where MkFoo3 :: forall x. x -> Foo3 x - type MkFoo1Sym1 (t0123456789876543210 :: a0123456789876543210) = - MkFoo1 t0123456789876543210 instance SuppressUnusedWarnings MkFoo1Sym0 where suppressUnusedWarnings = snd (((,) MkFoo1Sym0KindInference) ()) data MkFoo1Sym0 :: forall a0123456789876543210. @@ -18,8 +16,8 @@ Singletons/T249.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply MkFoo1Sym0 arg) (MkFoo1Sym1 arg) => MkFoo1Sym0 t0123456789876543210 type instance Apply MkFoo1Sym0 t0123456789876543210 = MkFoo1Sym1 t0123456789876543210 - type MkFoo2Sym1 (t0123456789876543210 :: x0123456789876543210) = - MkFoo2 t0123456789876543210 + type MkFoo1Sym1 (t0123456789876543210 :: a0123456789876543210) = + MkFoo1 t0123456789876543210 instance SuppressUnusedWarnings MkFoo2Sym0 where suppressUnusedWarnings = snd (((,) MkFoo2Sym0KindInference) ()) data MkFoo2Sym0 :: forall x0123456789876543210. @@ -29,8 +27,8 @@ Singletons/T249.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply MkFoo2Sym0 arg) (MkFoo2Sym1 arg) => MkFoo2Sym0 t0123456789876543210 type instance Apply MkFoo2Sym0 t0123456789876543210 = MkFoo2Sym1 t0123456789876543210 - type MkFoo3Sym1 (t0123456789876543210 :: x0123456789876543210) = - MkFoo3 t0123456789876543210 + type MkFoo2Sym1 (t0123456789876543210 :: x0123456789876543210) = + MkFoo2 t0123456789876543210 instance SuppressUnusedWarnings MkFoo3Sym0 where suppressUnusedWarnings = snd (((,) MkFoo3Sym0KindInference) ()) data MkFoo3Sym0 :: forall x0123456789876543210. @@ -40,6 +38,8 @@ Singletons/T249.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply MkFoo3Sym0 arg) (MkFoo3Sym1 arg) => MkFoo3Sym0 t0123456789876543210 type instance Apply MkFoo3Sym0 t0123456789876543210 = MkFoo3Sym1 t0123456789876543210 + type MkFoo3Sym1 (t0123456789876543210 :: x0123456789876543210) = + MkFoo3 t0123456789876543210 data SFoo1 :: forall a. Foo1 a -> Type where SMkFoo1 :: forall a (n :: a). diff --git a/tests/compile-and-dump/Singletons/T271.golden b/tests/compile-and-dump/Singletons/T271.golden index a0488327..5df01531 100644 --- a/tests/compile-and-dump/Singletons/T271.golden +++ b/tests/compile-and-dump/Singletons/T271.golden @@ -13,8 +13,6 @@ Singletons/T271.hs:(0,0)-(0,0): Splicing declarations data Identity :: Type -> Type where Identity :: a -> Identity a deriving (Eq, Ord) - type ConstantSym1 (t0123456789876543210 :: a0123456789876543210) = - Constant t0123456789876543210 instance SuppressUnusedWarnings ConstantSym0 where suppressUnusedWarnings = snd (((,) ConstantSym0KindInference) ()) data ConstantSym0 :: forall (a0123456789876543210 :: Type) @@ -25,8 +23,8 @@ Singletons/T271.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply ConstantSym0 arg) (ConstantSym1 arg) => ConstantSym0 t0123456789876543210 type instance Apply ConstantSym0 t0123456789876543210 = ConstantSym1 t0123456789876543210 - type IdentitySym1 (t0123456789876543210 :: a0123456789876543210) = - Identity t0123456789876543210 + type ConstantSym1 (t0123456789876543210 :: a0123456789876543210) = + Constant t0123456789876543210 instance SuppressUnusedWarnings IdentitySym0 where suppressUnusedWarnings = snd (((,) IdentitySym0KindInference) ()) data IdentitySym0 :: forall a0123456789876543210. @@ -36,20 +34,10 @@ Singletons/T271.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply IdentitySym0 arg) (IdentitySym1 arg) => IdentitySym0 t0123456789876543210 type instance Apply IdentitySym0 t0123456789876543210 = IdentitySym1 t0123456789876543210 + type IdentitySym1 (t0123456789876543210 :: a0123456789876543210) = + Identity t0123456789876543210 type family Compare_0123456789876543210 (a :: Constant a b) (a :: Constant a b) :: Ordering where Compare_0123456789876543210 (Constant a_0123456789876543210) (Constant b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[]) - type Compare_0123456789876543210Sym2 (a0123456789876543210 :: Constant a0123456789876543210 b0123456789876543210) (a0123456789876543210 :: Constant a0123456789876543210 b0123456789876543210) = - Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (Compare_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd (((,) Compare_0123456789876543210Sym1KindInference) ()) - data Compare_0123456789876543210Sym1 (a0123456789876543210 :: Constant a0123456789876543210 b0123456789876543210) :: (~>) (Constant a0123456789876543210 b0123456789876543210) Ordering - where - Compare_0123456789876543210Sym1KindInference :: forall a0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply (Compare_0123456789876543210Sym1 a0123456789876543210) arg) (Compare_0123456789876543210Sym2 a0123456789876543210 arg) => - Compare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 - type instance Apply (Compare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Compare_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Compare_0123456789876543210Sym0KindInference) ()) @@ -61,22 +49,22 @@ Singletons/T271.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => Compare_0123456789876543210Sym0 a0123456789876543210 type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 - instance POrd (Constant a b) where - type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a - type family Compare_0123456789876543210 (a :: Identity a) (a :: Identity a) :: Ordering where - Compare_0123456789876543210 (Identity a_0123456789876543210) (Identity b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[]) - type Compare_0123456789876543210Sym2 (a0123456789876543210 :: Identity a0123456789876543210) (a0123456789876543210 :: Identity a0123456789876543210) = - Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Compare_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Compare_0123456789876543210Sym1KindInference) ()) - data Compare_0123456789876543210Sym1 (a0123456789876543210 :: Identity a0123456789876543210) :: (~>) (Identity a0123456789876543210) Ordering + data Compare_0123456789876543210Sym1 (a0123456789876543210 :: Constant a0123456789876543210 b0123456789876543210) :: (~>) (Constant a0123456789876543210 b0123456789876543210) Ordering where Compare_0123456789876543210Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Compare_0123456789876543210Sym1 a0123456789876543210) arg) (Compare_0123456789876543210Sym2 a0123456789876543210 arg) => Compare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Compare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Compare_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 + type Compare_0123456789876543210Sym2 (a0123456789876543210 :: Constant a0123456789876543210 b0123456789876543210) (a0123456789876543210 :: Constant a0123456789876543210 b0123456789876543210) = + Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance POrd (Constant a b) where + type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a + type family Compare_0123456789876543210 (a :: Identity a) (a :: Identity a) :: Ordering where + Compare_0123456789876543210 (Identity a_0123456789876543210) (Identity b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[]) instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Compare_0123456789876543210Sym0KindInference) ()) @@ -87,6 +75,18 @@ Singletons/T271.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => Compare_0123456789876543210Sym0 a0123456789876543210 type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 + instance SuppressUnusedWarnings (Compare_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Compare_0123456789876543210Sym1KindInference) ()) + data Compare_0123456789876543210Sym1 (a0123456789876543210 :: Identity a0123456789876543210) :: (~>) (Identity a0123456789876543210) Ordering + where + Compare_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Compare_0123456789876543210Sym1 a0123456789876543210) arg) (Compare_0123456789876543210Sym2 a0123456789876543210 arg) => + Compare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Compare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Compare_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 + type Compare_0123456789876543210Sym2 (a0123456789876543210 :: Identity a0123456789876543210) (a0123456789876543210 :: Identity a0123456789876543210) = + Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance POrd (Identity a) where type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a type family Equals_0123456789876543210 (a :: Constant a b) (b :: Constant a b) :: Bool where diff --git a/tests/compile-and-dump/Singletons/T287.golden b/tests/compile-and-dump/Singletons/T287.golden index 8b28c6f2..e2939d5e 100644 --- a/tests/compile-and-dump/Singletons/T287.golden +++ b/tests/compile-and-dump/Singletons/T287.golden @@ -10,17 +10,6 @@ Singletons/T287.hs:(0,0)-(0,0): Splicing declarations (<<>>) :: a -> a -> a instance S b => S (a -> b) where (<<>>) f g = \ x -> (f x <<>> g x) - type (<<>>@#@$$$) (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: a0123456789876543210) = - (<<>>) arg0123456789876543210 arg0123456789876543210 - instance SuppressUnusedWarnings ((<<>>@#@$$) arg0123456789876543210) where - suppressUnusedWarnings = snd (((,) (:<<>>@#@$$###)) ()) - data (<<>>@#@$$) (arg0123456789876543210 :: a0123456789876543210) :: (~>) a0123456789876543210 a0123456789876543210 - where - (:<<>>@#@$$###) :: forall arg0123456789876543210 - arg0123456789876543210 - arg. SameKind (Apply ((<<>>@#@$$) arg0123456789876543210) arg) ((<<>>@#@$$$) arg0123456789876543210 arg) => - (<<>>@#@$$) arg0123456789876543210 arg0123456789876543210 - type instance Apply ((<<>>@#@$$) arg0123456789876543210) arg0123456789876543210 = (<<>>@#@$$$) arg0123456789876543210 arg0123456789876543210 instance SuppressUnusedWarnings (<<>>@#@$) where suppressUnusedWarnings = snd (((,) (:<<>>@#@$###)) ()) data (<<>>@#@$) :: forall a0123456789876543210. @@ -30,23 +19,30 @@ Singletons/T287.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (<<>>@#@$) arg) ((<<>>@#@$$) arg) => (<<>>@#@$) arg0123456789876543210 type instance Apply (<<>>@#@$) arg0123456789876543210 = (<<>>@#@$$) arg0123456789876543210 + instance SuppressUnusedWarnings ((<<>>@#@$$) arg0123456789876543210) where + suppressUnusedWarnings = snd (((,) (:<<>>@#@$$###)) ()) + data (<<>>@#@$$) (arg0123456789876543210 :: a0123456789876543210) :: (~>) a0123456789876543210 a0123456789876543210 + where + (:<<>>@#@$$###) :: forall arg0123456789876543210 + arg0123456789876543210 + arg. SameKind (Apply ((<<>>@#@$$) arg0123456789876543210) arg) ((<<>>@#@$$$) arg0123456789876543210 arg) => + (<<>>@#@$$) arg0123456789876543210 arg0123456789876543210 + type instance Apply ((<<>>@#@$$) arg0123456789876543210) arg0123456789876543210 = (<<>>@#@$$$) arg0123456789876543210 arg0123456789876543210 + type (<<>>@#@$$$) (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: a0123456789876543210) = + (<<>>) arg0123456789876543210 arg0123456789876543210 class PS a where type (<<>>) (arg :: a) (arg :: a) :: a type family Lambda_0123456789876543210 f g t where Lambda_0123456789876543210 f g x = Apply (Apply (<<>>@#@$) (Apply f x)) (Apply g x) - type Lambda_0123456789876543210Sym3 f0123456789876543210 g0123456789876543210 t0123456789876543210 = - Lambda_0123456789876543210 f0123456789876543210 g0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 g0123456789876543210 f0123456789876543210) where + instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) - data Lambda_0123456789876543210Sym2 f0123456789876543210 g0123456789876543210 t0123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) + data Lambda_0123456789876543210Sym0 f0123456789876543210 where - Lambda_0123456789876543210Sym2KindInference :: forall f0123456789876543210 - g0123456789876543210 - t0123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym2 f0123456789876543210 g0123456789876543210) arg) (Lambda_0123456789876543210Sym3 f0123456789876543210 g0123456789876543210 arg) => - Lambda_0123456789876543210Sym2 f0123456789876543210 g0123456789876543210 t0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 g0123456789876543210 f0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym3 g0123456789876543210 f0123456789876543210 t0123456789876543210 + Lambda_0123456789876543210Sym0KindInference :: forall f0123456789876543210 + arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => + Lambda_0123456789876543210Sym0 f0123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 f0123456789876543210 = Lambda_0123456789876543210Sym1 f0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 f0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) @@ -57,29 +53,21 @@ Singletons/T287.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Lambda_0123456789876543210Sym1 f0123456789876543210) arg) (Lambda_0123456789876543210Sym2 f0123456789876543210 arg) => Lambda_0123456789876543210Sym1 f0123456789876543210 g0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 f0123456789876543210) g0123456789876543210 = Lambda_0123456789876543210Sym2 f0123456789876543210 g0123456789876543210 - instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 f0123456789876543210 g0123456789876543210) where suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) - data Lambda_0123456789876543210Sym0 f0123456789876543210 + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 f0123456789876543210 g0123456789876543210 t0123456789876543210 where - Lambda_0123456789876543210Sym0KindInference :: forall f0123456789876543210 - arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 f0123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 f0123456789876543210 = Lambda_0123456789876543210Sym1 f0123456789876543210 + Lambda_0123456789876543210Sym2KindInference :: forall f0123456789876543210 + g0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym2 f0123456789876543210 g0123456789876543210) arg) (Lambda_0123456789876543210Sym3 f0123456789876543210 g0123456789876543210 arg) => + Lambda_0123456789876543210Sym2 f0123456789876543210 g0123456789876543210 t0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 f0123456789876543210 g0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym3 f0123456789876543210 g0123456789876543210 t0123456789876543210 + type Lambda_0123456789876543210Sym3 f0123456789876543210 g0123456789876543210 t0123456789876543210 = + Lambda_0123456789876543210 f0123456789876543210 g0123456789876543210 t0123456789876543210 type family TFHelper_0123456789876543210 (a :: (~>) a b) (a :: (~>) a b) :: (~>) a b where TFHelper_0123456789876543210 f g = Apply (Apply Lambda_0123456789876543210Sym0 f) g - type TFHelper_0123456789876543210Sym2 (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) = - TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (TFHelper_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd (((,) TFHelper_0123456789876543210Sym1KindInference) ()) - data TFHelper_0123456789876543210Sym1 (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) :: (~>) ((~>) a0123456789876543210 b0123456789876543210) ((~>) a0123456789876543210 b0123456789876543210) - where - TFHelper_0123456789876543210Sym1KindInference :: forall a0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply (TFHelper_0123456789876543210Sym1 a0123456789876543210) arg) (TFHelper_0123456789876543210Sym2 a0123456789876543210 arg) => - TFHelper_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 - type instance Apply (TFHelper_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = TFHelper_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) TFHelper_0123456789876543210Sym0KindInference) ()) @@ -91,6 +79,18 @@ Singletons/T287.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply TFHelper_0123456789876543210Sym0 arg) (TFHelper_0123456789876543210Sym1 arg) => TFHelper_0123456789876543210Sym0 a0123456789876543210 type instance Apply TFHelper_0123456789876543210Sym0 a0123456789876543210 = TFHelper_0123456789876543210Sym1 a0123456789876543210 + instance SuppressUnusedWarnings (TFHelper_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) TFHelper_0123456789876543210Sym1KindInference) ()) + data TFHelper_0123456789876543210Sym1 (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) :: (~>) ((~>) a0123456789876543210 b0123456789876543210) ((~>) a0123456789876543210 b0123456789876543210) + where + TFHelper_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (TFHelper_0123456789876543210Sym1 a0123456789876543210) arg) (TFHelper_0123456789876543210Sym2 a0123456789876543210 arg) => + TFHelper_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (TFHelper_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = TFHelper_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 + type TFHelper_0123456789876543210Sym2 (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) = + TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210 instance PS ((~>) a b) where type (<<>>) a a = Apply (Apply TFHelper_0123456789876543210Sym0 a) a class SS a where diff --git a/tests/compile-and-dump/Singletons/T29.golden b/tests/compile-and-dump/Singletons/T29.golden index 9688b8ee..fc1fe2fb 100644 --- a/tests/compile-and-dump/Singletons/T29.golden +++ b/tests/compile-and-dump/Singletons/T29.golden @@ -17,8 +17,6 @@ Singletons/T29.hs:(0,0)-(0,0): Splicing declarations baz x = (not $! x) ban :: Bool -> Bool ban x = ((not . (not . not)) $! x) - type BanSym1 (a0123456789876543210 :: Bool) = - Ban a0123456789876543210 instance SuppressUnusedWarnings BanSym0 where suppressUnusedWarnings = snd (((,) BanSym0KindInference) ()) data BanSym0 :: (~>) Bool Bool @@ -27,8 +25,8 @@ Singletons/T29.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply BanSym0 arg) (BanSym1 arg) => BanSym0 a0123456789876543210 type instance Apply BanSym0 a0123456789876543210 = BanSym1 a0123456789876543210 - type BazSym1 (a0123456789876543210 :: Bool) = - Baz a0123456789876543210 + type BanSym1 (a0123456789876543210 :: Bool) = + Ban a0123456789876543210 instance SuppressUnusedWarnings BazSym0 where suppressUnusedWarnings = snd (((,) BazSym0KindInference) ()) data BazSym0 :: (~>) Bool Bool @@ -37,8 +35,8 @@ Singletons/T29.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply BazSym0 arg) (BazSym1 arg) => BazSym0 a0123456789876543210 type instance Apply BazSym0 a0123456789876543210 = BazSym1 a0123456789876543210 - type BarSym1 (a0123456789876543210 :: Bool) = - Bar a0123456789876543210 + type BazSym1 (a0123456789876543210 :: Bool) = + Baz a0123456789876543210 instance SuppressUnusedWarnings BarSym0 where suppressUnusedWarnings = snd (((,) BarSym0KindInference) ()) data BarSym0 :: (~>) Bool Bool @@ -47,8 +45,8 @@ Singletons/T29.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply BarSym0 arg) (BarSym1 arg) => BarSym0 a0123456789876543210 type instance Apply BarSym0 a0123456789876543210 = BarSym1 a0123456789876543210 - type FooSym1 (a0123456789876543210 :: Bool) = - Foo a0123456789876543210 + type BarSym1 (a0123456789876543210 :: Bool) = + Bar a0123456789876543210 instance SuppressUnusedWarnings FooSym0 where suppressUnusedWarnings = snd (((,) FooSym0KindInference) ()) data FooSym0 :: (~>) Bool Bool @@ -57,6 +55,8 @@ Singletons/T29.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) => FooSym0 a0123456789876543210 type instance Apply FooSym0 a0123456789876543210 = FooSym1 a0123456789876543210 + type FooSym1 (a0123456789876543210 :: Bool) = + Foo a0123456789876543210 type family Ban (a :: Bool) :: Bool where Ban x = Apply (Apply ($!@#@$) (Apply (Apply (.@#@$) NotSym0) (Apply (Apply (.@#@$) NotSym0) NotSym0))) x type family Baz (a :: Bool) :: Bool where diff --git a/tests/compile-and-dump/Singletons/T297.golden b/tests/compile-and-dump/Singletons/T297.golden index 44185dca..09ff5204 100644 --- a/tests/compile-and-dump/Singletons/T297.golden +++ b/tests/compile-and-dump/Singletons/T297.golden @@ -25,7 +25,6 @@ Singletons/T297.hs:(0,0)-(0,0): Splicing declarations type Let0123456789876543210XSym0 = Let0123456789876543210X type family Let0123456789876543210X where Let0123456789876543210X = Let0123456789876543210ZSym0 - type FSym1 a0123456789876543210 = F a0123456789876543210 instance SuppressUnusedWarnings FSym0 where suppressUnusedWarnings = snd (((,) FSym0KindInference) ()) data FSym0 a0123456789876543210 @@ -34,6 +33,7 @@ Singletons/T297.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply FSym0 arg) (FSym1 arg) => FSym0 a0123456789876543210 type instance Apply FSym0 a0123456789876543210 = FSym1 a0123456789876543210 + type FSym1 a0123456789876543210 = F a0123456789876543210 type family F a where F MyProxy = Let0123456789876543210XSym0 sF :: forall arg. Sing arg -> Sing (Apply FSym0 arg) diff --git a/tests/compile-and-dump/Singletons/T312.golden b/tests/compile-and-dump/Singletons/T312.golden index 967be6fa..5b8ff299 100644 --- a/tests/compile-and-dump/Singletons/T312.golden +++ b/tests/compile-and-dump/Singletons/T312.golden @@ -19,8 +19,15 @@ Singletons/T312.hs:(0,0)-(0,0): Splicing declarations where h :: forall c. c -> b -> b h _ x = x - type BarSym2 (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: b0123456789876543210) = - Bar arg0123456789876543210 arg0123456789876543210 + instance SuppressUnusedWarnings BarSym0 where + suppressUnusedWarnings = snd (((,) BarSym0KindInference) ()) + data BarSym0 :: forall a0123456789876543210 b0123456789876543210. + (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210) + where + BarSym0KindInference :: forall arg0123456789876543210 + arg. SameKind (Apply BarSym0 arg) (BarSym1 arg) => + BarSym0 arg0123456789876543210 + type instance Apply BarSym0 arg0123456789876543210 = BarSym1 arg0123456789876543210 instance SuppressUnusedWarnings (BarSym1 arg0123456789876543210) where suppressUnusedWarnings = snd (((,) BarSym1KindInference) ()) data BarSym1 (arg0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. @@ -31,17 +38,17 @@ Singletons/T312.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (BarSym1 arg0123456789876543210) arg) (BarSym2 arg0123456789876543210 arg) => BarSym1 arg0123456789876543210 arg0123456789876543210 type instance Apply (BarSym1 arg0123456789876543210) arg0123456789876543210 = BarSym2 arg0123456789876543210 arg0123456789876543210 - instance SuppressUnusedWarnings BarSym0 where - suppressUnusedWarnings = snd (((,) BarSym0KindInference) ()) - data BarSym0 :: forall a0123456789876543210 b0123456789876543210. + type BarSym2 (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: b0123456789876543210) = + Bar arg0123456789876543210 arg0123456789876543210 + instance SuppressUnusedWarnings BazSym0 where + suppressUnusedWarnings = snd (((,) BazSym0KindInference) ()) + data BazSym0 :: forall a0123456789876543210 b0123456789876543210. (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210) where - BarSym0KindInference :: forall arg0123456789876543210 - arg. SameKind (Apply BarSym0 arg) (BarSym1 arg) => - BarSym0 arg0123456789876543210 - type instance Apply BarSym0 arg0123456789876543210 = BarSym1 arg0123456789876543210 - type BazSym2 (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: b0123456789876543210) = - Baz arg0123456789876543210 arg0123456789876543210 + BazSym0KindInference :: forall arg0123456789876543210 + arg. SameKind (Apply BazSym0 arg) (BazSym1 arg) => + BazSym0 arg0123456789876543210 + type instance Apply BazSym0 arg0123456789876543210 = BazSym1 arg0123456789876543210 instance SuppressUnusedWarnings (BazSym1 arg0123456789876543210) where suppressUnusedWarnings = snd (((,) BazSym1KindInference) ()) data BazSym1 (arg0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. @@ -52,19 +59,21 @@ Singletons/T312.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (BazSym1 arg0123456789876543210) arg) (BazSym2 arg0123456789876543210 arg) => BazSym1 arg0123456789876543210 arg0123456789876543210 type instance Apply (BazSym1 arg0123456789876543210) arg0123456789876543210 = BazSym2 arg0123456789876543210 arg0123456789876543210 - instance SuppressUnusedWarnings BazSym0 where - suppressUnusedWarnings = snd (((,) BazSym0KindInference) ()) - data BazSym0 :: forall a0123456789876543210 b0123456789876543210. - (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210) - where - BazSym0KindInference :: forall arg0123456789876543210 - arg. SameKind (Apply BazSym0 arg) (BazSym1 arg) => - BazSym0 arg0123456789876543210 - type instance Apply BazSym0 arg0123456789876543210 = BazSym1 arg0123456789876543210 + type BazSym2 (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: b0123456789876543210) = + Baz arg0123456789876543210 arg0123456789876543210 type family Bar_0123456789876543210 (a :: a) (a :: b) :: b where Bar_0123456789876543210 _ x = x - type Bar_0123456789876543210Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = - Bar_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Bar_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) Bar_0123456789876543210Sym0KindInference) ()) + data Bar_0123456789876543210Sym0 :: forall a0123456789876543210 + b0123456789876543210. + (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210) + where + Bar_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Bar_0123456789876543210Sym0 arg) (Bar_0123456789876543210Sym1 arg) => + Bar_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Bar_0123456789876543210Sym0 a0123456789876543210 = Bar_0123456789876543210Sym1 a0123456789876543210 instance SuppressUnusedWarnings (Bar_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Bar_0123456789876543210Sym1KindInference) ()) @@ -76,32 +85,27 @@ Singletons/T312.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Bar_0123456789876543210Sym1 a0123456789876543210) arg) (Bar_0123456789876543210Sym2 a0123456789876543210 arg) => Bar_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Bar_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Bar_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings Bar_0123456789876543210Sym0 where + type Bar_0123456789876543210Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = + Bar_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings Let0123456789876543210HSym0 where suppressUnusedWarnings - = snd (((,) Bar_0123456789876543210Sym0KindInference) ()) - data Bar_0123456789876543210Sym0 :: forall a0123456789876543210 - b0123456789876543210. - (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210) + = snd (((,) Let0123456789876543210HSym0KindInference) ()) + data Let0123456789876543210HSym0 a_01234567898765432100123456789876543210 where - Bar_0123456789876543210Sym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply Bar_0123456789876543210Sym0 arg) (Bar_0123456789876543210Sym1 arg) => - Bar_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Bar_0123456789876543210Sym0 a0123456789876543210 = Bar_0123456789876543210Sym1 a0123456789876543210 - type Let0123456789876543210HSym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 (a0123456789876543210 :: c0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = - Let0123456789876543210H a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (Let0123456789876543210HSym3 a0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where + Let0123456789876543210HSym0KindInference :: forall a_01234567898765432100123456789876543210 + arg. SameKind (Apply Let0123456789876543210HSym0 arg) (Let0123456789876543210HSym1 arg) => + Let0123456789876543210HSym0 a_01234567898765432100123456789876543210 + type instance Apply Let0123456789876543210HSym0 a_01234567898765432100123456789876543210 = Let0123456789876543210HSym1 a_01234567898765432100123456789876543210 + instance SuppressUnusedWarnings (Let0123456789876543210HSym1 a_01234567898765432100123456789876543210) where suppressUnusedWarnings - = snd (((,) Let0123456789876543210HSym3KindInference) ()) - data Let0123456789876543210HSym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 (a0123456789876543210 :: c0123456789876543210) :: forall b0123456789876543210. - (~>) b0123456789876543210 b0123456789876543210 + = snd (((,) Let0123456789876543210HSym1KindInference) ()) + data Let0123456789876543210HSym1 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where - Let0123456789876543210HSym3KindInference :: forall a_01234567898765432100123456789876543210 + Let0123456789876543210HSym1KindInference :: forall a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - a0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply (Let0123456789876543210HSym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a0123456789876543210) arg) (Let0123456789876543210HSym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a0123456789876543210 arg) => - Let0123456789876543210HSym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a0123456789876543210 a0123456789876543210 - type instance Apply (Let0123456789876543210HSym3 a0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a0123456789876543210 = Let0123456789876543210HSym4 a0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a0123456789876543210 + arg. SameKind (Apply (Let0123456789876543210HSym1 a_01234567898765432100123456789876543210) arg) (Let0123456789876543210HSym2 a_01234567898765432100123456789876543210 arg) => + Let0123456789876543210HSym1 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + type instance Apply (Let0123456789876543210HSym1 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Let0123456789876543210HSym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 instance SuppressUnusedWarnings (Let0123456789876543210HSym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Let0123456789876543210HSym2KindInference) ()) @@ -115,42 +119,25 @@ Singletons/T312.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Let0123456789876543210HSym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Let0123456789876543210HSym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => Let0123456789876543210HSym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a0123456789876543210 type instance Apply (Let0123456789876543210HSym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a0123456789876543210 = Let0123456789876543210HSym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (Let0123456789876543210HSym1 a_01234567898765432100123456789876543210) where + instance SuppressUnusedWarnings (Let0123456789876543210HSym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a0123456789876543210) where suppressUnusedWarnings - = snd (((,) Let0123456789876543210HSym1KindInference) ()) - data Let0123456789876543210HSym1 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + = snd (((,) Let0123456789876543210HSym3KindInference) ()) + data Let0123456789876543210HSym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 (a0123456789876543210 :: c0123456789876543210) :: forall b0123456789876543210. + (~>) b0123456789876543210 b0123456789876543210 where - Let0123456789876543210HSym1KindInference :: forall a_01234567898765432100123456789876543210 + Let0123456789876543210HSym3KindInference :: forall a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - arg. SameKind (Apply (Let0123456789876543210HSym1 a_01234567898765432100123456789876543210) arg) (Let0123456789876543210HSym2 a_01234567898765432100123456789876543210 arg) => - Let0123456789876543210HSym1 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - type instance Apply (Let0123456789876543210HSym1 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Let0123456789876543210HSym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings Let0123456789876543210HSym0 where - suppressUnusedWarnings - = snd (((,) Let0123456789876543210HSym0KindInference) ()) - data Let0123456789876543210HSym0 a_01234567898765432100123456789876543210 - where - Let0123456789876543210HSym0KindInference :: forall a_01234567898765432100123456789876543210 - arg. SameKind (Apply Let0123456789876543210HSym0 arg) (Let0123456789876543210HSym1 arg) => - Let0123456789876543210HSym0 a_01234567898765432100123456789876543210 - type instance Apply Let0123456789876543210HSym0 a_01234567898765432100123456789876543210 = Let0123456789876543210HSym1 a_01234567898765432100123456789876543210 + a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Let0123456789876543210HSym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a0123456789876543210) arg) (Let0123456789876543210HSym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a0123456789876543210 arg) => + Let0123456789876543210HSym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a0123456789876543210 a0123456789876543210 + type instance Apply (Let0123456789876543210HSym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a0123456789876543210) a0123456789876543210 = Let0123456789876543210HSym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a0123456789876543210 a0123456789876543210 + type Let0123456789876543210HSym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 (a0123456789876543210 :: c0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = + Let0123456789876543210H a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a0123456789876543210 a0123456789876543210 type family Let0123456789876543210H a_0123456789876543210 a_0123456789876543210 (a :: c) (a :: b) :: b where Let0123456789876543210H a_0123456789876543210 a_0123456789876543210 _ x = x type family Baz_0123456789876543210 (a :: a) (a :: b) :: b where Baz_0123456789876543210 a_0123456789876543210 a_0123456789876543210 = Apply (Apply (Let0123456789876543210HSym2 a_0123456789876543210 a_0123456789876543210) a_0123456789876543210) a_0123456789876543210 - type Baz_0123456789876543210Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = - Baz_0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (Baz_0123456789876543210Sym1 a0123456789876543210) where - suppressUnusedWarnings - = snd (((,) Baz_0123456789876543210Sym1KindInference) ()) - data Baz_0123456789876543210Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. - (~>) b0123456789876543210 b0123456789876543210 - where - Baz_0123456789876543210Sym1KindInference :: forall a0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply (Baz_0123456789876543210Sym1 a0123456789876543210) arg) (Baz_0123456789876543210Sym2 a0123456789876543210 arg) => - Baz_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 - type instance Apply (Baz_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Baz_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Baz_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Baz_0123456789876543210Sym0KindInference) ()) @@ -162,6 +149,19 @@ Singletons/T312.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Baz_0123456789876543210Sym0 arg) (Baz_0123456789876543210Sym1 arg) => Baz_0123456789876543210Sym0 a0123456789876543210 type instance Apply Baz_0123456789876543210Sym0 a0123456789876543210 = Baz_0123456789876543210Sym1 a0123456789876543210 + instance SuppressUnusedWarnings (Baz_0123456789876543210Sym1 a0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Baz_0123456789876543210Sym1KindInference) ()) + data Baz_0123456789876543210Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. + (~>) b0123456789876543210 b0123456789876543210 + where + Baz_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Baz_0123456789876543210Sym1 a0123456789876543210) arg) (Baz_0123456789876543210Sym2 a0123456789876543210 arg) => + Baz_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Baz_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Baz_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 + type Baz_0123456789876543210Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = + Baz_0123456789876543210 a0123456789876543210 a0123456789876543210 class PFoo a where type Bar (arg :: a) (arg :: b) :: b type Baz (arg :: a) (arg :: b) :: b diff --git a/tests/compile-and-dump/Singletons/T313.golden b/tests/compile-and-dump/Singletons/T313.golden index 4859deb1..cff515db 100644 --- a/tests/compile-and-dump/Singletons/T313.golden +++ b/tests/compile-and-dump/Singletons/T313.golden @@ -22,7 +22,6 @@ Singletons/T313.hs:(0,0)-(0,0): Splicing declarations type PFoo4 a = Maybe a instance PC a where type PFoo4 a = Maybe a - type PFoo1Sym1 a0123456789876543210 = PFoo1 a0123456789876543210 instance SuppressUnusedWarnings PFoo1Sym0 where suppressUnusedWarnings = snd (((,) PFoo1Sym0KindInference) ()) data PFoo1Sym0 a0123456789876543210 @@ -31,7 +30,7 @@ Singletons/T313.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply PFoo1Sym0 arg) (PFoo1Sym1 arg) => PFoo1Sym0 a0123456789876543210 type instance Apply PFoo1Sym0 a0123456789876543210 = PFoo1Sym1 a0123456789876543210 - type PFoo3Sym1 a0123456789876543210 = PFoo3 a0123456789876543210 + type PFoo1Sym1 a0123456789876543210 = PFoo1 a0123456789876543210 instance SuppressUnusedWarnings PFoo3Sym0 where suppressUnusedWarnings = snd (((,) PFoo3Sym0KindInference) ()) data PFoo3Sym0 a0123456789876543210 @@ -40,8 +39,7 @@ Singletons/T313.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply PFoo3Sym0 arg) (PFoo3Sym1 arg) => PFoo3Sym0 a0123456789876543210 type instance Apply PFoo3Sym0 a0123456789876543210 = PFoo3Sym1 a0123456789876543210 - type PFoo2Sym1 (a0123456789876543210 :: Type) = - PFoo2 a0123456789876543210 + type PFoo3Sym1 a0123456789876543210 = PFoo3 a0123456789876543210 instance SuppressUnusedWarnings PFoo2Sym0 where suppressUnusedWarnings = snd (((,) PFoo2Sym0KindInference) ()) data PFoo2Sym0 :: (~>) Type Type @@ -50,8 +48,8 @@ Singletons/T313.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply PFoo2Sym0 arg) (PFoo2Sym1 arg) => PFoo2Sym0 a0123456789876543210 type instance Apply PFoo2Sym0 a0123456789876543210 = PFoo2Sym1 a0123456789876543210 - type PFoo4Sym1 (a0123456789876543210 :: Type) = - PFoo4 a0123456789876543210 + type PFoo2Sym1 (a0123456789876543210 :: Type) = + PFoo2 a0123456789876543210 instance SuppressUnusedWarnings PFoo4Sym0 where suppressUnusedWarnings = snd (((,) PFoo4Sym0KindInference) ()) data PFoo4Sym0 :: (~>) Type Type @@ -60,6 +58,8 @@ Singletons/T313.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply PFoo4Sym0 arg) (PFoo4Sym1 arg) => PFoo4Sym0 a0123456789876543210 type instance Apply PFoo4Sym0 a0123456789876543210 = PFoo4Sym1 a0123456789876543210 + type PFoo4Sym1 (a0123456789876543210 :: Type) = + PFoo4 a0123456789876543210 class PPC (a :: Type) instance PPC a Singletons/T313.hs:(0,0)-(0,0): Splicing declarations @@ -86,7 +86,6 @@ Singletons/T313.hs:(0,0)-(0,0): Splicing declarations type SFoo4 a = Maybe a instance SC a where type SFoo4 a = Maybe a - type SFoo1Sym1 a0123456789876543210 = SFoo1 a0123456789876543210 instance SuppressUnusedWarnings SFoo1Sym0 where suppressUnusedWarnings = snd (((,) SFoo1Sym0KindInference) ()) data SFoo1Sym0 a0123456789876543210 @@ -95,7 +94,7 @@ Singletons/T313.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply SFoo1Sym0 arg) (SFoo1Sym1 arg) => SFoo1Sym0 a0123456789876543210 type instance Apply SFoo1Sym0 a0123456789876543210 = SFoo1Sym1 a0123456789876543210 - type SFoo3Sym1 a0123456789876543210 = SFoo3 a0123456789876543210 + type SFoo1Sym1 a0123456789876543210 = SFoo1 a0123456789876543210 instance SuppressUnusedWarnings SFoo3Sym0 where suppressUnusedWarnings = snd (((,) SFoo3Sym0KindInference) ()) data SFoo3Sym0 a0123456789876543210 @@ -104,8 +103,7 @@ Singletons/T313.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply SFoo3Sym0 arg) (SFoo3Sym1 arg) => SFoo3Sym0 a0123456789876543210 type instance Apply SFoo3Sym0 a0123456789876543210 = SFoo3Sym1 a0123456789876543210 - type SFoo2Sym1 (a0123456789876543210 :: Type) = - SFoo2 a0123456789876543210 + type SFoo3Sym1 a0123456789876543210 = SFoo3 a0123456789876543210 instance SuppressUnusedWarnings SFoo2Sym0 where suppressUnusedWarnings = snd (((,) SFoo2Sym0KindInference) ()) data SFoo2Sym0 :: (~>) Type Type @@ -114,8 +112,8 @@ Singletons/T313.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply SFoo2Sym0 arg) (SFoo2Sym1 arg) => SFoo2Sym0 a0123456789876543210 type instance Apply SFoo2Sym0 a0123456789876543210 = SFoo2Sym1 a0123456789876543210 - type SFoo4Sym1 (a0123456789876543210 :: Type) = - SFoo4 a0123456789876543210 + type SFoo2Sym1 (a0123456789876543210 :: Type) = + SFoo2 a0123456789876543210 instance SuppressUnusedWarnings SFoo4Sym0 where suppressUnusedWarnings = snd (((,) SFoo4Sym0KindInference) ()) data SFoo4Sym0 :: (~>) Type Type @@ -124,6 +122,8 @@ Singletons/T313.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply SFoo4Sym0 arg) (SFoo4Sym1 arg) => SFoo4Sym0 a0123456789876543210 type instance Apply SFoo4Sym0 a0123456789876543210 = SFoo4Sym1 a0123456789876543210 + type SFoo4Sym1 (a0123456789876543210 :: Type) = + SFoo4 a0123456789876543210 class PSC (a :: Type) instance PSC a class SSC (a :: Type) diff --git a/tests/compile-and-dump/Singletons/T316.golden b/tests/compile-and-dump/Singletons/T316.golden index f9bbe3d5..46240460 100644 --- a/tests/compile-and-dump/Singletons/T316.golden +++ b/tests/compile-and-dump/Singletons/T316.golden @@ -3,19 +3,16 @@ Singletons/T316.hs:(0,0)-(0,0): Splicing declarations [d| replaceAllGTypes :: (a -> Type -> a) -> [Type] -> [a] -> [a] replaceAllGTypes f types as = zipWith f as types |] ======> - type ReplaceAllGTypesSym3 (a0123456789876543210 :: (~>) a0123456789876543210 ((~>) Type a0123456789876543210)) (a0123456789876543210 :: [Type]) (a0123456789876543210 :: [a0123456789876543210]) = - ReplaceAllGTypes a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (ReplaceAllGTypesSym2 a0123456789876543210 a0123456789876543210) where + instance SuppressUnusedWarnings ReplaceAllGTypesSym0 where suppressUnusedWarnings - = snd (((,) ReplaceAllGTypesSym2KindInference) ()) - data ReplaceAllGTypesSym2 (a0123456789876543210 :: (~>) a0123456789876543210 ((~>) Type a0123456789876543210)) (a0123456789876543210 :: [Type]) :: (~>) [a0123456789876543210] [a0123456789876543210] + = snd (((,) ReplaceAllGTypesSym0KindInference) ()) + data ReplaceAllGTypesSym0 :: forall a0123456789876543210. + (~>) ((~>) a0123456789876543210 ((~>) Type a0123456789876543210)) ((~>) [Type] ((~>) [a0123456789876543210] [a0123456789876543210])) where - ReplaceAllGTypesSym2KindInference :: forall a0123456789876543210 - a0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply (ReplaceAllGTypesSym2 a0123456789876543210 a0123456789876543210) arg) (ReplaceAllGTypesSym3 a0123456789876543210 a0123456789876543210 arg) => - ReplaceAllGTypesSym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 - type instance Apply (ReplaceAllGTypesSym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ReplaceAllGTypesSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 + ReplaceAllGTypesSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply ReplaceAllGTypesSym0 arg) (ReplaceAllGTypesSym1 arg) => + ReplaceAllGTypesSym0 a0123456789876543210 + type instance Apply ReplaceAllGTypesSym0 a0123456789876543210 = ReplaceAllGTypesSym1 a0123456789876543210 instance SuppressUnusedWarnings (ReplaceAllGTypesSym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ReplaceAllGTypesSym1KindInference) ()) @@ -26,15 +23,18 @@ Singletons/T316.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (ReplaceAllGTypesSym1 a0123456789876543210) arg) (ReplaceAllGTypesSym2 a0123456789876543210 arg) => ReplaceAllGTypesSym1 a0123456789876543210 a0123456789876543210 type instance Apply (ReplaceAllGTypesSym1 a0123456789876543210) a0123456789876543210 = ReplaceAllGTypesSym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ReplaceAllGTypesSym0 where + instance SuppressUnusedWarnings (ReplaceAllGTypesSym2 a0123456789876543210 a0123456789876543210) where suppressUnusedWarnings - = snd (((,) ReplaceAllGTypesSym0KindInference) ()) - data ReplaceAllGTypesSym0 :: forall a0123456789876543210. - (~>) ((~>) a0123456789876543210 ((~>) Type a0123456789876543210)) ((~>) [Type] ((~>) [a0123456789876543210] [a0123456789876543210])) + = snd (((,) ReplaceAllGTypesSym2KindInference) ()) + data ReplaceAllGTypesSym2 (a0123456789876543210 :: (~>) a0123456789876543210 ((~>) Type a0123456789876543210)) (a0123456789876543210 :: [Type]) :: (~>) [a0123456789876543210] [a0123456789876543210] where - ReplaceAllGTypesSym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply ReplaceAllGTypesSym0 arg) (ReplaceAllGTypesSym1 arg) => - ReplaceAllGTypesSym0 a0123456789876543210 - type instance Apply ReplaceAllGTypesSym0 a0123456789876543210 = ReplaceAllGTypesSym1 a0123456789876543210 + ReplaceAllGTypesSym2KindInference :: forall a0123456789876543210 + a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ReplaceAllGTypesSym2 a0123456789876543210 a0123456789876543210) arg) (ReplaceAllGTypesSym3 a0123456789876543210 a0123456789876543210 arg) => + ReplaceAllGTypesSym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type instance Apply (ReplaceAllGTypesSym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ReplaceAllGTypesSym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type ReplaceAllGTypesSym3 (a0123456789876543210 :: (~>) a0123456789876543210 ((~>) Type a0123456789876543210)) (a0123456789876543210 :: [Type]) (a0123456789876543210 :: [a0123456789876543210]) = + ReplaceAllGTypes a0123456789876543210 a0123456789876543210 a0123456789876543210 type family ReplaceAllGTypes (a :: (~>) a ((~>) Type a)) (a :: [Type]) (a :: [a]) :: [a] where ReplaceAllGTypes f types as = Apply (Apply (Apply ZipWithSym0 f) as) types diff --git a/tests/compile-and-dump/Singletons/T322.golden b/tests/compile-and-dump/Singletons/T322.golden index c3985dca..90e8d220 100644 --- a/tests/compile-and-dump/Singletons/T322.golden +++ b/tests/compile-and-dump/Singletons/T322.golden @@ -8,9 +8,15 @@ Singletons/T322.hs:(0,0)-(0,0): Splicing declarations (!) :: Bool -> Bool -> Bool (!) = (||) infixr 2 ! - type (!@#@$$$) (a0123456789876543210 :: Bool) (a0123456789876543210 :: Bool) = - (!) a0123456789876543210 a0123456789876543210 - infixr 2 !@#@$$$ + instance SuppressUnusedWarnings (!@#@$) where + suppressUnusedWarnings = snd (((,) (:!@#@$###)) ()) + data (!@#@$) :: (~>) Bool ((~>) Bool Bool) + where + (:!@#@$###) :: forall a0123456789876543210 + arg. SameKind (Apply (!@#@$) arg) ((!@#@$$) arg) => + (!@#@$) a0123456789876543210 + type instance Apply (!@#@$) a0123456789876543210 = (!@#@$$) a0123456789876543210 + infixr 2 !@#@$ instance SuppressUnusedWarnings ((!@#@$$) a0123456789876543210) where suppressUnusedWarnings = snd (((,) (:!@#@$$###)) ()) data (!@#@$$) (a0123456789876543210 :: Bool) :: (~>) Bool Bool @@ -21,15 +27,9 @@ Singletons/T322.hs:(0,0)-(0,0): Splicing declarations (!@#@$$) a0123456789876543210 a0123456789876543210 type instance Apply ((!@#@$$) a0123456789876543210) a0123456789876543210 = (!@#@$$$) a0123456789876543210 a0123456789876543210 infixr 2 !@#@$$ - instance SuppressUnusedWarnings (!@#@$) where - suppressUnusedWarnings = snd (((,) (:!@#@$###)) ()) - data (!@#@$) :: (~>) Bool ((~>) Bool Bool) - where - (:!@#@$###) :: forall a0123456789876543210 - arg. SameKind (Apply (!@#@$) arg) ((!@#@$$) arg) => - (!@#@$) a0123456789876543210 - type instance Apply (!@#@$) a0123456789876543210 = (!@#@$$) a0123456789876543210 - infixr 2 !@#@$ + type (!@#@$$$) (a0123456789876543210 :: Bool) (a0123456789876543210 :: Bool) = + (!) a0123456789876543210 a0123456789876543210 + infixr 2 !@#@$$$ type family (!) (a :: Bool) (a :: Bool) :: Bool where (!) a_0123456789876543210 a_0123456789876543210 = Apply (Apply (||@#@$) a_0123456789876543210) a_0123456789876543210 infixr 2 %! diff --git a/tests/compile-and-dump/Singletons/T33.golden b/tests/compile-and-dump/Singletons/T33.golden index 093665b8..af2898f8 100644 --- a/tests/compile-and-dump/Singletons/T33.golden +++ b/tests/compile-and-dump/Singletons/T33.golden @@ -5,8 +5,6 @@ Singletons/T33.hs:(0,0)-(0,0): Splicing declarations ======> foo :: (Bool, Bool) -> () foo ~(_, _) = () - type FooSym1 (a0123456789876543210 :: (Bool, Bool)) = - Foo a0123456789876543210 instance SuppressUnusedWarnings FooSym0 where suppressUnusedWarnings = snd (((,) FooSym0KindInference) ()) data FooSym0 :: (~>) (Bool, Bool) () @@ -15,6 +13,8 @@ Singletons/T33.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) => FooSym0 a0123456789876543210 type instance Apply FooSym0 a0123456789876543210 = FooSym1 a0123456789876543210 + type FooSym1 (a0123456789876543210 :: (Bool, Bool)) = + Foo a0123456789876543210 type family Foo (a :: (Bool, Bool)) :: () where Foo '(_, _) = Tuple0Sym0 sFoo :: diff --git a/tests/compile-and-dump/Singletons/T332.golden b/tests/compile-and-dump/Singletons/T332.golden index eea4a4a9..5a20f21f 100644 --- a/tests/compile-and-dump/Singletons/T332.golden +++ b/tests/compile-and-dump/Singletons/T332.golden @@ -8,7 +8,6 @@ Singletons/T332.hs:(0,0)-(0,0): Splicing declarations data Foo = MkFoo f :: Foo -> () f MkFoo {} = () - type FSym1 (a0123456789876543210 :: Foo) = F a0123456789876543210 instance SuppressUnusedWarnings FSym0 where suppressUnusedWarnings = snd (((,) FSym0KindInference) ()) data FSym0 :: (~>) Foo () @@ -17,6 +16,7 @@ Singletons/T332.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply FSym0 arg) (FSym1 arg) => FSym0 a0123456789876543210 type instance Apply FSym0 a0123456789876543210 = FSym1 a0123456789876543210 + type FSym1 (a0123456789876543210 :: Foo) = F a0123456789876543210 type family F (a :: Foo) :: () where F MkFoo = Tuple0Sym0 type MkFooSym0 = MkFoo @@ -31,7 +31,6 @@ Singletons/T332.hs:(0,0)-(0,0): Splicing declarations b :: Bar -> () b MkBar {} = () type MkBarSym0 = MkBar - type BSym1 (a0123456789876543210 :: Bar) = B a0123456789876543210 instance SuppressUnusedWarnings BSym0 where suppressUnusedWarnings = snd (((,) BSym0KindInference) ()) data BSym0 :: (~>) Bar () @@ -40,6 +39,7 @@ Singletons/T332.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply BSym0 arg) (BSym1 arg) => BSym0 a0123456789876543210 type instance Apply BSym0 a0123456789876543210 = BSym1 a0123456789876543210 + type BSym1 (a0123456789876543210 :: Bar) = B a0123456789876543210 type family B (a :: Bar) :: () where B MkBar = Tuple0Sym0 sB :: forall (t :: Bar). Sing t -> Sing (Apply BSym0 t :: ()) diff --git a/tests/compile-and-dump/Singletons/T342.golden b/tests/compile-and-dump/Singletons/T342.golden index 29607cd7..928790c5 100644 --- a/tests/compile-and-dump/Singletons/T342.golden +++ b/tests/compile-and-dump/Singletons/T342.golden @@ -6,7 +6,6 @@ Singletons/T342.hs:(0,0)-(0,0): Splicing declarations pure $ syn : defuns ======> type MyId a = a - type MyIdSym1 a0123456789876543210 = MyId a0123456789876543210 instance SuppressUnusedWarnings MyIdSym0 where suppressUnusedWarnings = snd (((,) MyIdSym0KindInference) ()) data MyIdSym0 a0123456789876543210 @@ -15,3 +14,4 @@ Singletons/T342.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply MyIdSym0 arg) (MyIdSym1 arg) => MyIdSym0 a0123456789876543210 type instance Apply MyIdSym0 a0123456789876543210 = MyIdSym1 a0123456789876543210 + type MyIdSym1 a0123456789876543210 = MyId a0123456789876543210 diff --git a/tests/compile-and-dump/Singletons/T353.golden b/tests/compile-and-dump/Singletons/T353.golden index da74980e..86420b22 100644 --- a/tests/compile-and-dump/Singletons/T353.golden +++ b/tests/compile-and-dump/Singletons/T353.golden @@ -7,28 +7,6 @@ Singletons/T353.hs:(0,0)-(0,0): Splicing declarations ======> type family Symmetry (a :: Proxy t) (y :: Proxy t) (e :: (:~:) (a :: Proxy (t :: k)) (y :: Proxy (t :: k))) :: Type where Symmetry a y _ = (:~:) y a - type SymmetrySym3 (a0123456789876543210 :: Proxy t0123456789876543210) (y0123456789876543210 :: Proxy t0123456789876543210) (e0123456789876543210 :: (:~:) (a0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210)) (y0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210))) = - Symmetry a0123456789876543210 y0123456789876543210 e0123456789876543210 - instance SuppressUnusedWarnings (SymmetrySym2 y0123456789876543210 a0123456789876543210) where - suppressUnusedWarnings = snd (((,) SymmetrySym2KindInference) ()) - data SymmetrySym2 (a0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210)) (y0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210)) :: (~>) ((:~:) (a0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210)) (y0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210))) Type - where - SymmetrySym2KindInference :: forall a0123456789876543210 - y0123456789876543210 - e0123456789876543210 - arg. SameKind (Apply (SymmetrySym2 a0123456789876543210 y0123456789876543210) arg) (SymmetrySym3 a0123456789876543210 y0123456789876543210 arg) => - SymmetrySym2 a0123456789876543210 y0123456789876543210 e0123456789876543210 - type instance Apply (SymmetrySym2 y0123456789876543210 a0123456789876543210) e0123456789876543210 = SymmetrySym3 y0123456789876543210 a0123456789876543210 e0123456789876543210 - instance SuppressUnusedWarnings (SymmetrySym1 a0123456789876543210) where - suppressUnusedWarnings = snd (((,) SymmetrySym1KindInference) ()) - data SymmetrySym1 (a0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210)) :: forall (y0123456789876543210 :: Proxy t0123456789876543210). - (~>) (Proxy t0123456789876543210) ((~>) ((:~:) (a0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210)) (y0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210))) Type) - where - SymmetrySym1KindInference :: forall a0123456789876543210 - y0123456789876543210 - arg. SameKind (Apply (SymmetrySym1 a0123456789876543210) arg) (SymmetrySym2 a0123456789876543210 arg) => - SymmetrySym1 a0123456789876543210 y0123456789876543210 - type instance Apply (SymmetrySym1 a0123456789876543210) y0123456789876543210 = SymmetrySym2 a0123456789876543210 y0123456789876543210 instance SuppressUnusedWarnings SymmetrySym0 where suppressUnusedWarnings = snd (((,) SymmetrySym0KindInference) ()) data SymmetrySym0 :: forall k0123456789876543210 @@ -41,25 +19,31 @@ Singletons/T353.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply SymmetrySym0 arg) (SymmetrySym1 arg) => SymmetrySym0 a0123456789876543210 type instance Apply SymmetrySym0 a0123456789876543210 = SymmetrySym1 a0123456789876543210 + instance SuppressUnusedWarnings (SymmetrySym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) SymmetrySym1KindInference) ()) + data SymmetrySym1 (a0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210)) :: forall (y0123456789876543210 :: Proxy t0123456789876543210). + (~>) (Proxy t0123456789876543210) ((~>) ((:~:) (a0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210)) (y0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210))) Type) + where + SymmetrySym1KindInference :: forall a0123456789876543210 + y0123456789876543210 + arg. SameKind (Apply (SymmetrySym1 a0123456789876543210) arg) (SymmetrySym2 a0123456789876543210 arg) => + SymmetrySym1 a0123456789876543210 y0123456789876543210 + type instance Apply (SymmetrySym1 a0123456789876543210) y0123456789876543210 = SymmetrySym2 a0123456789876543210 y0123456789876543210 + instance SuppressUnusedWarnings (SymmetrySym2 a0123456789876543210 y0123456789876543210) where + suppressUnusedWarnings = snd (((,) SymmetrySym2KindInference) ()) + data SymmetrySym2 (a0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210)) (y0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210)) :: (~>) ((:~:) (a0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210)) (y0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210))) Type + where + SymmetrySym2KindInference :: forall a0123456789876543210 + y0123456789876543210 + e0123456789876543210 + arg. SameKind (Apply (SymmetrySym2 a0123456789876543210 y0123456789876543210) arg) (SymmetrySym3 a0123456789876543210 y0123456789876543210 arg) => + SymmetrySym2 a0123456789876543210 y0123456789876543210 e0123456789876543210 + type instance Apply (SymmetrySym2 a0123456789876543210 y0123456789876543210) e0123456789876543210 = SymmetrySym3 a0123456789876543210 y0123456789876543210 e0123456789876543210 + type SymmetrySym3 (a0123456789876543210 :: Proxy t0123456789876543210) (y0123456789876543210 :: Proxy t0123456789876543210) (e0123456789876543210 :: (:~:) (a0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210)) (y0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210))) = + Symmetry a0123456789876543210 y0123456789876543210 e0123456789876543210 Singletons/T353.hs:0:0:: Splicing declarations genDefunSymbols [''Prod] ======> - type MkProdSym2 (t0123456789876543210 :: f0123456789876543210 p0123456789876543210) (t0123456789876543210 :: g0123456789876543210 p0123456789876543210) = - 'MkProd t0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (MkProdSym1 t0123456789876543210) where - suppressUnusedWarnings = snd (((,) MkProdSym1KindInference) ()) - data MkProdSym1 (t0123456789876543210 :: (f0123456789876543210 :: k0123456789876543210 - -> Type) (p0123456789876543210 :: k0123456789876543210)) :: forall (g0123456789876543210 :: k0123456789876543210 - -> Type). - (~>) (g0123456789876543210 p0123456789876543210) (Prod (f0123456789876543210 :: k0123456789876543210 - -> Type) (g0123456789876543210 :: k0123456789876543210 - -> Type) (p0123456789876543210 :: k0123456789876543210)) - where - MkProdSym1KindInference :: forall t0123456789876543210 - t0123456789876543210 - arg. SameKind (Apply (MkProdSym1 t0123456789876543210) arg) (MkProdSym2 t0123456789876543210 arg) => - MkProdSym1 t0123456789876543210 t0123456789876543210 - type instance Apply (MkProdSym1 t0123456789876543210) t0123456789876543210 = MkProdSym2 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings MkProdSym0 where suppressUnusedWarnings = snd (((,) MkProdSym0KindInference) ()) data MkProdSym0 :: forall k0123456789876543210 @@ -74,22 +58,25 @@ Singletons/T353.hs:0:0:: Splicing declarations arg. SameKind (Apply MkProdSym0 arg) (MkProdSym1 arg) => MkProdSym0 t0123456789876543210 type instance Apply MkProdSym0 t0123456789876543210 = MkProdSym1 t0123456789876543210 + instance SuppressUnusedWarnings (MkProdSym1 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) MkProdSym1KindInference) ()) + data MkProdSym1 (t0123456789876543210 :: (f0123456789876543210 :: k0123456789876543210 + -> Type) (p0123456789876543210 :: k0123456789876543210)) :: forall (g0123456789876543210 :: k0123456789876543210 + -> Type). + (~>) (g0123456789876543210 p0123456789876543210) (Prod (f0123456789876543210 :: k0123456789876543210 + -> Type) (g0123456789876543210 :: k0123456789876543210 + -> Type) (p0123456789876543210 :: k0123456789876543210)) + where + MkProdSym1KindInference :: forall t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (MkProdSym1 t0123456789876543210) arg) (MkProdSym2 t0123456789876543210 arg) => + MkProdSym1 t0123456789876543210 t0123456789876543210 + type instance Apply (MkProdSym1 t0123456789876543210) t0123456789876543210 = MkProdSym2 t0123456789876543210 t0123456789876543210 + type MkProdSym2 (t0123456789876543210 :: f0123456789876543210 p0123456789876543210) (t0123456789876543210 :: g0123456789876543210 p0123456789876543210) = + 'MkProd t0123456789876543210 t0123456789876543210 Singletons/T353.hs:0:0:: Splicing declarations genDefunSymbols [''Foo] ======> - type MkFooSym2 (t0123456789876543210 :: Proxy a0123456789876543210) (t0123456789876543210 :: Proxy b0123456789876543210) = - 'MkFoo t0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (MkFooSym1 t0123456789876543210) where - suppressUnusedWarnings = snd (((,) MkFooSym1KindInference) ()) - data MkFooSym1 (t0123456789876543210 :: Proxy (a0123456789876543210 :: k0123456789876543210)) :: forall k0123456789876543210 - (b0123456789876543210 :: k0123456789876543210). - (~>) (Proxy b0123456789876543210) (Foo (a0123456789876543210 :: k0123456789876543210) (b0123456789876543210 :: k0123456789876543210)) - where - MkFooSym1KindInference :: forall t0123456789876543210 - t0123456789876543210 - arg. SameKind (Apply (MkFooSym1 t0123456789876543210) arg) (MkFooSym2 t0123456789876543210 arg) => - MkFooSym1 t0123456789876543210 t0123456789876543210 - type instance Apply (MkFooSym1 t0123456789876543210) t0123456789876543210 = MkFooSym2 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings MkFooSym0 where suppressUnusedWarnings = snd (((,) MkFooSym0KindInference) ()) data MkFooSym0 :: forall k0123456789876543210 @@ -102,3 +89,16 @@ Singletons/T353.hs:0:0:: Splicing declarations arg. SameKind (Apply MkFooSym0 arg) (MkFooSym1 arg) => MkFooSym0 t0123456789876543210 type instance Apply MkFooSym0 t0123456789876543210 = MkFooSym1 t0123456789876543210 + instance SuppressUnusedWarnings (MkFooSym1 t0123456789876543210) where + suppressUnusedWarnings = snd (((,) MkFooSym1KindInference) ()) + data MkFooSym1 (t0123456789876543210 :: Proxy (a0123456789876543210 :: k0123456789876543210)) :: forall k0123456789876543210 + (b0123456789876543210 :: k0123456789876543210). + (~>) (Proxy b0123456789876543210) (Foo (a0123456789876543210 :: k0123456789876543210) (b0123456789876543210 :: k0123456789876543210)) + where + MkFooSym1KindInference :: forall t0123456789876543210 + t0123456789876543210 + arg. SameKind (Apply (MkFooSym1 t0123456789876543210) arg) (MkFooSym2 t0123456789876543210 arg) => + MkFooSym1 t0123456789876543210 t0123456789876543210 + type instance Apply (MkFooSym1 t0123456789876543210) t0123456789876543210 = MkFooSym2 t0123456789876543210 t0123456789876543210 + type MkFooSym2 (t0123456789876543210 :: Proxy a0123456789876543210) (t0123456789876543210 :: Proxy b0123456789876543210) = + 'MkFoo t0123456789876543210 t0123456789876543210 diff --git a/tests/compile-and-dump/Singletons/T358.golden b/tests/compile-and-dump/Singletons/T358.golden index 1b268ab4..d6be48af 100644 --- a/tests/compile-and-dump/Singletons/T358.golden +++ b/tests/compile-and-dump/Singletons/T358.golden @@ -28,8 +28,6 @@ Singletons/T358.hs:(0,0)-(0,0): Splicing declarations type Method1Sym0 = Method1 class PC1 (f :: k -> Type) where type Method1 :: f a - type Method2aSym1 (arg0123456789876543210 :: b0123456789876543210) = - Method2a arg0123456789876543210 instance SuppressUnusedWarnings Method2aSym0 where suppressUnusedWarnings = snd (((,) Method2aSym0KindInference) ()) data Method2aSym0 :: forall b0123456789876543210 @@ -40,8 +38,8 @@ Singletons/T358.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Method2aSym0 arg) (Method2aSym1 arg) => Method2aSym0 arg0123456789876543210 type instance Apply Method2aSym0 arg0123456789876543210 = Method2aSym1 arg0123456789876543210 - type Method2bSym1 (arg0123456789876543210 :: b0123456789876543210) = - Method2b arg0123456789876543210 + type Method2aSym1 (arg0123456789876543210 :: b0123456789876543210) = + Method2a arg0123456789876543210 instance SuppressUnusedWarnings Method2bSym0 where suppressUnusedWarnings = snd (((,) Method2bSym0KindInference) ()) data Method2bSym0 :: forall b0123456789876543210 @@ -52,6 +50,8 @@ Singletons/T358.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Method2bSym0 arg) (Method2bSym1 arg) => Method2bSym0 arg0123456789876543210 type instance Apply Method2bSym0 arg0123456789876543210 = Method2bSym1 arg0123456789876543210 + type Method2bSym1 (arg0123456789876543210 :: b0123456789876543210) = + Method2b arg0123456789876543210 class PC2 a where type Method2a (arg :: b) :: a type Method2b (arg :: b) :: a @@ -62,8 +62,6 @@ Singletons/T358.hs:(0,0)-(0,0): Splicing declarations type Method1 = Method1_0123456789876543210Sym0 type family Method2a_0123456789876543210 (a :: b) :: [a] where Method2a_0123456789876543210 _ = '[] - type Method2a_0123456789876543210Sym1 (a0123456789876543210 :: b0123456789876543210) = - Method2a_0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Method2a_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Method2a_0123456789876543210Sym0KindInference) ()) @@ -75,10 +73,10 @@ Singletons/T358.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Method2a_0123456789876543210Sym0 arg) (Method2a_0123456789876543210Sym1 arg) => Method2a_0123456789876543210Sym0 a0123456789876543210 type instance Apply Method2a_0123456789876543210Sym0 a0123456789876543210 = Method2a_0123456789876543210Sym1 a0123456789876543210 + type Method2a_0123456789876543210Sym1 (a0123456789876543210 :: b0123456789876543210) = + Method2a_0123456789876543210 a0123456789876543210 type family Method2b_0123456789876543210 (a :: b) :: [a] where Method2b_0123456789876543210 _ = '[] - type Method2b_0123456789876543210Sym1 (a0123456789876543210 :: b0123456789876543210) = - Method2b_0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Method2b_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Method2b_0123456789876543210Sym0KindInference) ()) @@ -90,6 +88,8 @@ Singletons/T358.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Method2b_0123456789876543210Sym0 arg) (Method2b_0123456789876543210Sym1 arg) => Method2b_0123456789876543210Sym0 a0123456789876543210 type instance Apply Method2b_0123456789876543210Sym0 a0123456789876543210 = Method2b_0123456789876543210Sym1 a0123456789876543210 + type Method2b_0123456789876543210Sym1 (a0123456789876543210 :: b0123456789876543210) = + Method2b_0123456789876543210 a0123456789876543210 instance PC2 [a] where type Method2a a = Apply Method2a_0123456789876543210Sym0 a type Method2b a = Apply Method2b_0123456789876543210Sym0 a diff --git a/tests/compile-and-dump/Singletons/T367.golden b/tests/compile-and-dump/Singletons/T367.golden index 2aa85cc9..9971e97e 100644 --- a/tests/compile-and-dump/Singletons/T367.golden +++ b/tests/compile-and-dump/Singletons/T367.golden @@ -3,19 +3,6 @@ Singletons/T367.hs:(0,0)-(0,0): Splicing declarations [d| const' :: a -> b -> a const' x _ = x |] ======> - type Const'Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = - Const' a0123456789876543210 a0123456789876543210 - instance Data.Singletons.SuppressUnusedWarnings.SuppressUnusedWarnings (Const'Sym1 a0123456789876543210) where - Data.Singletons.SuppressUnusedWarnings.suppressUnusedWarnings - = snd (((,) Const'Sym1KindInference) ()) - data Const'Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. - (~>) b0123456789876543210 a0123456789876543210 - where - Const'Sym1KindInference :: forall a0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply (Const'Sym1 a0123456789876543210) arg) (Const'Sym2 a0123456789876543210 arg) => - Const'Sym1 a0123456789876543210 a0123456789876543210 - type instance Apply (Const'Sym1 a0123456789876543210) a0123456789876543210 = Const'Sym2 a0123456789876543210 a0123456789876543210 instance Data.Singletons.SuppressUnusedWarnings.SuppressUnusedWarnings Const'Sym0 where Data.Singletons.SuppressUnusedWarnings.suppressUnusedWarnings = snd (((,) Const'Sym0KindInference) ()) @@ -27,6 +14,19 @@ Singletons/T367.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Const'Sym0 arg) (Const'Sym1 arg) => Const'Sym0 a0123456789876543210 type instance Apply Const'Sym0 a0123456789876543210 = Const'Sym1 a0123456789876543210 + instance Data.Singletons.SuppressUnusedWarnings.SuppressUnusedWarnings (Const'Sym1 a0123456789876543210) where + Data.Singletons.SuppressUnusedWarnings.suppressUnusedWarnings + = snd (((,) Const'Sym1KindInference) ()) + data Const'Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. + (~>) b0123456789876543210 a0123456789876543210 + where + Const'Sym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (Const'Sym1 a0123456789876543210) arg) (Const'Sym2 a0123456789876543210 arg) => + Const'Sym1 a0123456789876543210 a0123456789876543210 + type instance Apply (Const'Sym1 a0123456789876543210) a0123456789876543210 = Const'Sym2 a0123456789876543210 a0123456789876543210 + type Const'Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = + Const' a0123456789876543210 a0123456789876543210 type family Const' (a :: a) (a :: b) :: a where Const' x _ = x sConst' :: diff --git a/tests/compile-and-dump/Singletons/T371.golden b/tests/compile-and-dump/Singletons/T371.golden index 62d30043..8067c5b0 100644 --- a/tests/compile-and-dump/Singletons/T371.golden +++ b/tests/compile-and-dump/Singletons/T371.golden @@ -14,8 +14,6 @@ Singletons/T371.hs:(0,0)-(0,0): Splicing declarations = Y1 | Y2 (X a) deriving Show type X1Sym0 = X1 - type X2Sym1 (t0123456789876543210 :: Y a0123456789876543210) = - X2 t0123456789876543210 instance SuppressUnusedWarnings X2Sym0 where suppressUnusedWarnings = snd (((,) X2Sym0KindInference) ()) data X2Sym0 :: forall (a0123456789876543210 :: Type). @@ -25,9 +23,9 @@ Singletons/T371.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply X2Sym0 arg) (X2Sym1 arg) => X2Sym0 t0123456789876543210 type instance Apply X2Sym0 t0123456789876543210 = X2Sym1 t0123456789876543210 + type X2Sym1 (t0123456789876543210 :: Y a0123456789876543210) = + X2 t0123456789876543210 type Y1Sym0 = Y1 - type Y2Sym1 (t0123456789876543210 :: X a0123456789876543210) = - Y2 t0123456789876543210 instance SuppressUnusedWarnings Y2Sym0 where suppressUnusedWarnings = snd (((,) Y2Sym0KindInference) ()) data Y2Sym0 :: forall (a0123456789876543210 :: Type). @@ -37,22 +35,21 @@ Singletons/T371.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Y2Sym0 arg) (Y2Sym1 arg) => Y2Sym0 t0123456789876543210 type instance Apply Y2Sym0 t0123456789876543210 = Y2Sym1 t0123456789876543210 + type Y2Sym1 (t0123456789876543210 :: X a0123456789876543210) = + Y2 t0123456789876543210 type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: X a) (a :: GHC.Types.Symbol) :: GHC.Types.Symbol where ShowsPrec_0123456789876543210 _ X1 a_0123456789876543210 = Apply (Apply ShowStringSym0 "X1") a_0123456789876543210 ShowsPrec_0123456789876543210 p_0123456789876543210 (X2 arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (Data.Singletons.Prelude.Num.FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "X2 ")) (Apply (Apply ShowsPrecSym0 (Data.Singletons.Prelude.Num.FromInteger 11)) arg_0123456789876543210))) a_0123456789876543210 - type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: X a0123456789876543210) (a0123456789876543210 :: GHC.Types.Symbol) = - ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where suppressUnusedWarnings - = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) - data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: X a0123456789876543210) :: (~>) GHC.Types.Symbol GHC.Types.Symbol + = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) + data ShowsPrec_0123456789876543210Sym0 :: forall a0123456789876543210. + (~>) GHC.Types.Nat ((~>) (X a0123456789876543210) ((~>) GHC.Types.Symbol GHC.Types.Symbol)) where - ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 - a0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => - ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 - type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 + ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => + ShowsPrec_0123456789876543210Sym0 a0123456789876543210 + type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ()) @@ -64,27 +61,10 @@ Singletons/T371.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) => ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where - suppressUnusedWarnings - = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) - data ShowsPrec_0123456789876543210Sym0 :: forall a0123456789876543210. - (~>) GHC.Types.Nat ((~>) (X a0123456789876543210) ((~>) GHC.Types.Symbol GHC.Types.Symbol)) - where - ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => - ShowsPrec_0123456789876543210Sym0 a0123456789876543210 - type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 - instance PShow (X a) where - type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a - type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Y a) (a :: GHC.Types.Symbol) :: GHC.Types.Symbol where - ShowsPrec_0123456789876543210 _ Y1 a_0123456789876543210 = Apply (Apply ShowStringSym0 "Y1") a_0123456789876543210 - ShowsPrec_0123456789876543210 p_0123456789876543210 (Y2 arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (Data.Singletons.Prelude.Num.FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "Y2 ")) (Apply (Apply ShowsPrecSym0 (Data.Singletons.Prelude.Num.FromInteger 11)) arg_0123456789876543210))) a_0123456789876543210 - type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Y a0123456789876543210) (a0123456789876543210 :: GHC.Types.Symbol) = - ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) - data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Y a0123456789876543210) :: (~>) GHC.Types.Symbol GHC.Types.Symbol + data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: X a0123456789876543210) :: (~>) GHC.Types.Symbol GHC.Types.Symbol where ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 a0123456789876543210 @@ -92,6 +72,23 @@ Singletons/T371.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: X a0123456789876543210) (a0123456789876543210 :: GHC.Types.Symbol) = + ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 + instance PShow (X a) where + type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a + type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Y a) (a :: GHC.Types.Symbol) :: GHC.Types.Symbol where + ShowsPrec_0123456789876543210 _ Y1 a_0123456789876543210 = Apply (Apply ShowStringSym0 "Y1") a_0123456789876543210 + ShowsPrec_0123456789876543210 p_0123456789876543210 (Y2 arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (Data.Singletons.Prelude.Num.FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "Y2 ")) (Apply (Apply ShowsPrecSym0 (Data.Singletons.Prelude.Num.FromInteger 11)) arg_0123456789876543210))) a_0123456789876543210 + instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where + suppressUnusedWarnings + = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) + data ShowsPrec_0123456789876543210Sym0 :: forall a0123456789876543210. + (~>) GHC.Types.Nat ((~>) (Y a0123456789876543210) ((~>) GHC.Types.Symbol GHC.Types.Symbol)) + where + ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => + ShowsPrec_0123456789876543210Sym0 a0123456789876543210 + type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ()) @@ -103,16 +100,19 @@ Singletons/T371.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) => ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where + instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where suppressUnusedWarnings - = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) - data ShowsPrec_0123456789876543210Sym0 :: forall a0123456789876543210. - (~>) GHC.Types.Nat ((~>) (Y a0123456789876543210) ((~>) GHC.Types.Symbol GHC.Types.Symbol)) + = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) + data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Y a0123456789876543210) :: (~>) GHC.Types.Symbol GHC.Types.Symbol where - ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => - ShowsPrec_0123456789876543210Sym0 a0123456789876543210 - type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 + ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 + a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => + ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 a0123456789876543210 + type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Y a0123456789876543210) (a0123456789876543210 :: GHC.Types.Symbol) = + ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance PShow (Y a) where type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a data SX :: forall a. X a -> Type diff --git a/tests/compile-and-dump/Singletons/T376.golden b/tests/compile-and-dump/Singletons/T376.golden index e44043ba..52de2935 100644 --- a/tests/compile-and-dump/Singletons/T376.golden +++ b/tests/compile-and-dump/Singletons/T376.golden @@ -5,8 +5,14 @@ Singletons/T376.hs:(0,0)-(0,0): Splicing declarations ======> f :: (() -> ()) -> () -> () f g = g :: () -> () - type FSym2 (a0123456789876543210 :: (~>) () ()) (a0123456789876543210 :: ()) = - F a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings FSym0 where + suppressUnusedWarnings = snd (((,) FSym0KindInference) ()) + data FSym0 :: (~>) ((~>) () ()) ((~>) () ()) + where + FSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply FSym0 arg) (FSym1 arg) => + FSym0 a0123456789876543210 + type instance Apply FSym0 a0123456789876543210 = FSym1 a0123456789876543210 instance SuppressUnusedWarnings (FSym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) FSym1KindInference) ()) data FSym1 (a0123456789876543210 :: (~>) () ()) :: (~>) () () @@ -16,14 +22,8 @@ Singletons/T376.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (FSym1 a0123456789876543210) arg) (FSym2 a0123456789876543210 arg) => FSym1 a0123456789876543210 a0123456789876543210 type instance Apply (FSym1 a0123456789876543210) a0123456789876543210 = FSym2 a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings FSym0 where - suppressUnusedWarnings = snd (((,) FSym0KindInference) ()) - data FSym0 :: (~>) ((~>) () ()) ((~>) () ()) - where - FSym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply FSym0 arg) (FSym1 arg) => - FSym0 a0123456789876543210 - type instance Apply FSym0 a0123456789876543210 = FSym1 a0123456789876543210 + type FSym2 (a0123456789876543210 :: (~>) () ()) (a0123456789876543210 :: ()) = + F a0123456789876543210 a0123456789876543210 type family F (a :: (~>) () ()) (a :: ()) :: () where F g a_0123456789876543210 = Apply (g :: (~>) () ()) a_0123456789876543210 sF :: diff --git a/tests/compile-and-dump/Singletons/T378a.golden b/tests/compile-and-dump/Singletons/T378a.golden index 89db6e44..bde4c1eb 100644 --- a/tests/compile-and-dump/Singletons/T378a.golden +++ b/tests/compile-and-dump/Singletons/T378a.golden @@ -22,18 +22,6 @@ Singletons/T378a.hs:(0,0)-(0,0): Splicing declarations type Proxy2Sym0 = Proxy2 type Proxy3Sym0 = Proxy3 type Proxy4Sym0 = Proxy4 - type ConstBASym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = - ConstBA a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (ConstBASym1 a0123456789876543210) where - suppressUnusedWarnings = snd (((,) ConstBASym1KindInference) ()) - data ConstBASym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. - (~>) b0123456789876543210 a0123456789876543210 - where - ConstBASym1KindInference :: forall a0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply (ConstBASym1 a0123456789876543210) arg) (ConstBASym2 a0123456789876543210 arg) => - ConstBASym1 a0123456789876543210 a0123456789876543210 - type instance Apply (ConstBASym1 a0123456789876543210) a0123456789876543210 = ConstBASym2 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings ConstBASym0 where suppressUnusedWarnings = snd (((,) ConstBASym0KindInference) ()) data ConstBASym0 :: forall a0123456789876543210 @@ -44,6 +32,18 @@ Singletons/T378a.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply ConstBASym0 arg) (ConstBASym1 arg) => ConstBASym0 a0123456789876543210 type instance Apply ConstBASym0 a0123456789876543210 = ConstBASym1 a0123456789876543210 + instance SuppressUnusedWarnings (ConstBASym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) ConstBASym1KindInference) ()) + data ConstBASym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. + (~>) b0123456789876543210 a0123456789876543210 + where + ConstBASym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (ConstBASym1 a0123456789876543210) arg) (ConstBASym2 a0123456789876543210 arg) => + ConstBASym1 a0123456789876543210 a0123456789876543210 + type instance Apply (ConstBASym1 a0123456789876543210) a0123456789876543210 = ConstBASym2 a0123456789876543210 a0123456789876543210 + type ConstBASym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = + ConstBA a0123456789876543210 a0123456789876543210 type family ConstBA (a :: a) (a :: b) :: a where ConstBA x _ = x sConstBA :: diff --git a/tests/compile-and-dump/Singletons/T402.golden b/tests/compile-and-dump/Singletons/T402.golden index 7af92b2b..2c045139 100644 --- a/tests/compile-and-dump/Singletons/T402.golden +++ b/tests/compile-and-dump/Singletons/T402.golden @@ -2,8 +2,6 @@ Singletons/T402.hs:0:0:: Splicing declarations singletons [d| type AnyOfKind (k :: Type) = Any :: k |] ======> type AnyOfKind (k :: Type) = Any :: k - type AnyOfKindSym1 (k0123456789876543210 :: Type) = - AnyOfKind k0123456789876543210 instance SuppressUnusedWarnings AnyOfKindSym0 where suppressUnusedWarnings = snd (((,) AnyOfKindSym0KindInference) ()) data AnyOfKindSym0 :: forall (k0123456789876543210 :: Type). @@ -13,3 +11,5 @@ Singletons/T402.hs:0:0:: Splicing declarations arg. SameKind (Apply AnyOfKindSym0 arg) (AnyOfKindSym1 arg) => AnyOfKindSym0 k0123456789876543210 type instance Apply AnyOfKindSym0 k0123456789876543210 = AnyOfKindSym1 k0123456789876543210 + type AnyOfKindSym1 (k0123456789876543210 :: Type) = + AnyOfKind k0123456789876543210 diff --git a/tests/compile-and-dump/Singletons/T410.golden b/tests/compile-and-dump/Singletons/T410.golden index 20c81f31..7ebe2a59 100644 --- a/tests/compile-and-dump/Singletons/T410.golden +++ b/tests/compile-and-dump/Singletons/T410.golden @@ -10,18 +10,6 @@ Singletons/T410.hs:(0,0)-(0,0): Splicing declarations equals :: a -> a -> Bool instance Eq () where equals () () = True - type EqualsSym2 (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: a0123456789876543210) = - Equals arg0123456789876543210 arg0123456789876543210 - instance Data.Singletons.SuppressUnusedWarnings.SuppressUnusedWarnings (EqualsSym1 arg0123456789876543210) where - Data.Singletons.SuppressUnusedWarnings.suppressUnusedWarnings - = snd (((,) EqualsSym1KindInference) ()) - data EqualsSym1 (arg0123456789876543210 :: a0123456789876543210) :: (~>) a0123456789876543210 Bool - where - EqualsSym1KindInference :: forall arg0123456789876543210 - arg0123456789876543210 - arg. SameKind (Apply (EqualsSym1 arg0123456789876543210) arg) (EqualsSym2 arg0123456789876543210 arg) => - EqualsSym1 arg0123456789876543210 arg0123456789876543210 - type instance Apply (EqualsSym1 arg0123456789876543210) arg0123456789876543210 = EqualsSym2 arg0123456789876543210 arg0123456789876543210 instance Data.Singletons.SuppressUnusedWarnings.SuppressUnusedWarnings EqualsSym0 where Data.Singletons.SuppressUnusedWarnings.suppressUnusedWarnings = snd (((,) EqualsSym0KindInference) ()) @@ -32,12 +20,31 @@ Singletons/T410.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply EqualsSym0 arg) (EqualsSym1 arg) => EqualsSym0 arg0123456789876543210 type instance Apply EqualsSym0 arg0123456789876543210 = EqualsSym1 arg0123456789876543210 + instance Data.Singletons.SuppressUnusedWarnings.SuppressUnusedWarnings (EqualsSym1 arg0123456789876543210) where + Data.Singletons.SuppressUnusedWarnings.suppressUnusedWarnings + = snd (((,) EqualsSym1KindInference) ()) + data EqualsSym1 (arg0123456789876543210 :: a0123456789876543210) :: (~>) a0123456789876543210 Bool + where + EqualsSym1KindInference :: forall arg0123456789876543210 + arg0123456789876543210 + arg. SameKind (Apply (EqualsSym1 arg0123456789876543210) arg) (EqualsSym2 arg0123456789876543210 arg) => + EqualsSym1 arg0123456789876543210 arg0123456789876543210 + type instance Apply (EqualsSym1 arg0123456789876543210) arg0123456789876543210 = EqualsSym2 arg0123456789876543210 arg0123456789876543210 + type EqualsSym2 (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: a0123456789876543210) = + Equals arg0123456789876543210 arg0123456789876543210 class PEq a where type Equals (arg :: a) (arg :: a) :: Bool type family Equals_0123456789876543210 (a :: ()) (a :: ()) :: Bool where Equals_0123456789876543210 '() '() = TrueSym0 - type Equals_0123456789876543210Sym2 (a0123456789876543210 :: ()) (a0123456789876543210 :: ()) = - Equals_0123456789876543210 a0123456789876543210 a0123456789876543210 + instance Data.Singletons.SuppressUnusedWarnings.SuppressUnusedWarnings Equals_0123456789876543210Sym0 where + Data.Singletons.SuppressUnusedWarnings.suppressUnusedWarnings + = snd (((,) Equals_0123456789876543210Sym0KindInference) ()) + data Equals_0123456789876543210Sym0 :: (~>) () ((~>) () Bool) + where + Equals_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Equals_0123456789876543210Sym0 arg) (Equals_0123456789876543210Sym1 arg) => + Equals_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Equals_0123456789876543210Sym0 a0123456789876543210 = Equals_0123456789876543210Sym1 a0123456789876543210 instance Data.Singletons.SuppressUnusedWarnings.SuppressUnusedWarnings (Equals_0123456789876543210Sym1 a0123456789876543210) where Data.Singletons.SuppressUnusedWarnings.suppressUnusedWarnings = snd (((,) Equals_0123456789876543210Sym1KindInference) ()) @@ -48,14 +55,7 @@ Singletons/T410.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (Equals_0123456789876543210Sym1 a0123456789876543210) arg) (Equals_0123456789876543210Sym2 a0123456789876543210 arg) => Equals_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Equals_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Equals_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 - instance Data.Singletons.SuppressUnusedWarnings.SuppressUnusedWarnings Equals_0123456789876543210Sym0 where - Data.Singletons.SuppressUnusedWarnings.suppressUnusedWarnings - = snd (((,) Equals_0123456789876543210Sym0KindInference) ()) - data Equals_0123456789876543210Sym0 :: (~>) () ((~>) () Bool) - where - Equals_0123456789876543210Sym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply Equals_0123456789876543210Sym0 arg) (Equals_0123456789876543210Sym1 arg) => - Equals_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Equals_0123456789876543210Sym0 a0123456789876543210 = Equals_0123456789876543210Sym1 a0123456789876543210 + type Equals_0123456789876543210Sym2 (a0123456789876543210 :: ()) (a0123456789876543210 :: ()) = + Equals_0123456789876543210 a0123456789876543210 a0123456789876543210 instance PEq () where type Equals a a = Apply (Apply Equals_0123456789876543210Sym0 a) a diff --git a/tests/compile-and-dump/Singletons/T412.golden b/tests/compile-and-dump/Singletons/T412.golden index bd26895f..e10ba7ca 100644 --- a/tests/compile-and-dump/Singletons/T412.golden +++ b/tests/compile-and-dump/Singletons/T412.golden @@ -25,9 +25,15 @@ Singletons/T412.hs:(0,0)-(0,0): Splicing declarations infixr 5 `D1` infixr 5 `MkD1` data D1 a b = MkD1 a b - type T1aSym2 a0123456789876543210 b0123456789876543210 = - T1a a0123456789876543210 b0123456789876543210 - infixl 5 `T1aSym2` + instance SuppressUnusedWarnings T1aSym0 where + suppressUnusedWarnings = snd (((,) T1aSym0KindInference) ()) + data T1aSym0 a0123456789876543210 + where + T1aSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply T1aSym0 arg) (T1aSym1 arg) => + T1aSym0 a0123456789876543210 + type instance Apply T1aSym0 a0123456789876543210 = T1aSym1 a0123456789876543210 + infixl 5 `T1aSym0` instance SuppressUnusedWarnings (T1aSym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) T1aSym1KindInference) ()) data T1aSym1 a0123456789876543210 b0123456789876543210 @@ -38,18 +44,18 @@ Singletons/T412.hs:(0,0)-(0,0): Splicing declarations T1aSym1 a0123456789876543210 b0123456789876543210 type instance Apply (T1aSym1 a0123456789876543210) b0123456789876543210 = T1aSym2 a0123456789876543210 b0123456789876543210 infixl 5 `T1aSym1` - instance SuppressUnusedWarnings T1aSym0 where - suppressUnusedWarnings = snd (((,) T1aSym0KindInference) ()) - data T1aSym0 a0123456789876543210 + type T1aSym2 a0123456789876543210 b0123456789876543210 = + T1a a0123456789876543210 b0123456789876543210 + infixl 5 `T1aSym2` + instance SuppressUnusedWarnings T1bSym0 where + suppressUnusedWarnings = snd (((,) T1bSym0KindInference) ()) + data T1bSym0 a0123456789876543210 where - T1aSym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply T1aSym0 arg) (T1aSym1 arg) => - T1aSym0 a0123456789876543210 - type instance Apply T1aSym0 a0123456789876543210 = T1aSym1 a0123456789876543210 - infixl 5 `T1aSym0` - type T1bSym2 a0123456789876543210 b0123456789876543210 = - T1b a0123456789876543210 b0123456789876543210 - infixl 5 `T1bSym2` + T1bSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply T1bSym0 arg) (T1bSym1 arg) => + T1bSym0 a0123456789876543210 + type instance Apply T1bSym0 a0123456789876543210 = T1bSym1 a0123456789876543210 + infixl 5 `T1bSym0` instance SuppressUnusedWarnings (T1bSym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) T1bSym1KindInference) ()) data T1bSym1 a0123456789876543210 b0123456789876543210 @@ -60,18 +66,19 @@ Singletons/T412.hs:(0,0)-(0,0): Splicing declarations T1bSym1 a0123456789876543210 b0123456789876543210 type instance Apply (T1bSym1 a0123456789876543210) b0123456789876543210 = T1bSym2 a0123456789876543210 b0123456789876543210 infixl 5 `T1bSym1` - instance SuppressUnusedWarnings T1bSym0 where - suppressUnusedWarnings = snd (((,) T1bSym0KindInference) ()) - data T1bSym0 a0123456789876543210 + type T1bSym2 a0123456789876543210 b0123456789876543210 = + T1b a0123456789876543210 b0123456789876543210 + infixl 5 `T1bSym2` + instance SuppressUnusedWarnings MkD1Sym0 where + suppressUnusedWarnings = snd (((,) MkD1Sym0KindInference) ()) + data MkD1Sym0 :: forall a0123456789876543210 b0123456789876543210. + (~>) a0123456789876543210 ((~>) b0123456789876543210 (D1 a0123456789876543210 b0123456789876543210)) where - T1bSym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply T1bSym0 arg) (T1bSym1 arg) => - T1bSym0 a0123456789876543210 - type instance Apply T1bSym0 a0123456789876543210 = T1bSym1 a0123456789876543210 - infixl 5 `T1bSym0` - type MkD1Sym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) = - MkD1 t0123456789876543210 t0123456789876543210 - infixr 5 `MkD1Sym2` + MkD1Sym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply MkD1Sym0 arg) (MkD1Sym1 arg) => + MkD1Sym0 t0123456789876543210 + type instance Apply MkD1Sym0 t0123456789876543210 = MkD1Sym1 t0123456789876543210 + infixr 5 `MkD1Sym0` instance SuppressUnusedWarnings (MkD1Sym1 t0123456789876543210) where suppressUnusedWarnings = snd (((,) MkD1Sym1KindInference) ()) data MkD1Sym1 (t0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. @@ -83,21 +90,21 @@ Singletons/T412.hs:(0,0)-(0,0): Splicing declarations MkD1Sym1 t0123456789876543210 t0123456789876543210 type instance Apply (MkD1Sym1 t0123456789876543210) t0123456789876543210 = MkD1Sym2 t0123456789876543210 t0123456789876543210 infixr 5 `MkD1Sym1` - instance SuppressUnusedWarnings MkD1Sym0 where - suppressUnusedWarnings = snd (((,) MkD1Sym0KindInference) ()) - data MkD1Sym0 :: forall a0123456789876543210 b0123456789876543210. - (~>) a0123456789876543210 ((~>) b0123456789876543210 (D1 a0123456789876543210 b0123456789876543210)) - where - MkD1Sym0KindInference :: forall t0123456789876543210 - arg. SameKind (Apply MkD1Sym0 arg) (MkD1Sym1 arg) => - MkD1Sym0 t0123456789876543210 - type instance Apply MkD1Sym0 t0123456789876543210 = MkD1Sym1 t0123456789876543210 - infixr 5 `MkD1Sym0` + type MkD1Sym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) = + MkD1 t0123456789876543210 t0123456789876543210 + infixr 5 `MkD1Sym2` infix 6 `M1` infix 5 `PC1` - type M1Sym2 (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: b0123456789876543210) = - M1 arg0123456789876543210 arg0123456789876543210 - infix 6 `M1Sym2` + instance SuppressUnusedWarnings M1Sym0 where + suppressUnusedWarnings = snd (((,) M1Sym0KindInference) ()) + data M1Sym0 :: forall a0123456789876543210 b0123456789876543210. + (~>) a0123456789876543210 ((~>) b0123456789876543210 Bool) + where + M1Sym0KindInference :: forall arg0123456789876543210 + arg. SameKind (Apply M1Sym0 arg) (M1Sym1 arg) => + M1Sym0 arg0123456789876543210 + type instance Apply M1Sym0 arg0123456789876543210 = M1Sym1 arg0123456789876543210 + infix 6 `M1Sym0` instance SuppressUnusedWarnings (M1Sym1 arg0123456789876543210) where suppressUnusedWarnings = snd (((,) M1Sym1KindInference) ()) data M1Sym1 (arg0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. @@ -109,16 +116,9 @@ Singletons/T412.hs:(0,0)-(0,0): Splicing declarations M1Sym1 arg0123456789876543210 arg0123456789876543210 type instance Apply (M1Sym1 arg0123456789876543210) arg0123456789876543210 = M1Sym2 arg0123456789876543210 arg0123456789876543210 infix 6 `M1Sym1` - instance SuppressUnusedWarnings M1Sym0 where - suppressUnusedWarnings = snd (((,) M1Sym0KindInference) ()) - data M1Sym0 :: forall a0123456789876543210 b0123456789876543210. - (~>) a0123456789876543210 ((~>) b0123456789876543210 Bool) - where - M1Sym0KindInference :: forall arg0123456789876543210 - arg. SameKind (Apply M1Sym0 arg) (M1Sym1 arg) => - M1Sym0 arg0123456789876543210 - type instance Apply M1Sym0 arg0123456789876543210 = M1Sym1 arg0123456789876543210 - infix 6 `M1Sym0` + type M1Sym2 (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: b0123456789876543210) = + M1 arg0123456789876543210 arg0123456789876543210 + infix 6 `M1Sym2` class PC1 a b where type M1 (arg :: a) (arg :: b) :: Bool infixr 5 `SMkD1` @@ -154,9 +154,16 @@ Singletons/T412.hs:(0,0)-(0,0): Splicing declarations Singletons/T412.hs:0:0:: Splicing declarations genSingletons [''C2, ''T2a, ''T2b, ''D2] ======> - type M2Sym2 (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: b0123456789876543210) = - M2 arg0123456789876543210 arg0123456789876543210 - infix 6 `M2Sym2` + instance SuppressUnusedWarnings M2Sym0 where + suppressUnusedWarnings = snd (((,) M2Sym0KindInference) ()) + data M2Sym0 :: forall a0123456789876543210 b0123456789876543210. + (~>) a0123456789876543210 ((~>) b0123456789876543210 Bool) + where + M2Sym0KindInference :: forall arg0123456789876543210 + arg. SameKind (Apply M2Sym0 arg) (M2Sym1 arg) => + M2Sym0 arg0123456789876543210 + type instance Apply M2Sym0 arg0123456789876543210 = M2Sym1 arg0123456789876543210 + infix 6 `M2Sym0` instance SuppressUnusedWarnings (M2Sym1 arg0123456789876543210) where suppressUnusedWarnings = snd (((,) M2Sym1KindInference) ()) data M2Sym1 (arg0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. @@ -168,16 +175,9 @@ Singletons/T412.hs:0:0:: Splicing declarations M2Sym1 arg0123456789876543210 arg0123456789876543210 type instance Apply (M2Sym1 arg0123456789876543210) arg0123456789876543210 = M2Sym2 arg0123456789876543210 arg0123456789876543210 infix 6 `M2Sym1` - instance SuppressUnusedWarnings M2Sym0 where - suppressUnusedWarnings = snd (((,) M2Sym0KindInference) ()) - data M2Sym0 :: forall a0123456789876543210 b0123456789876543210. - (~>) a0123456789876543210 ((~>) b0123456789876543210 Bool) - where - M2Sym0KindInference :: forall arg0123456789876543210 - arg. SameKind (Apply M2Sym0 arg) (M2Sym1 arg) => - M2Sym0 arg0123456789876543210 - type instance Apply M2Sym0 arg0123456789876543210 = M2Sym1 arg0123456789876543210 - infix 6 `M2Sym0` + type M2Sym2 (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: b0123456789876543210) = + M2 arg0123456789876543210 arg0123456789876543210 + infix 6 `M2Sym2` class PC2 (a :: GHC.Types.Type) (b :: GHC.Types.Type) where type M2 (arg :: a) (arg :: b) :: Bool infix 5 `PC2` @@ -193,9 +193,15 @@ Singletons/T412.hs:0:0:: Splicing declarations instance (SC2 a b, SingI d) => SingI (M2Sym1 (d :: a) :: (~>) b Bool) where sing = (singFun1 @(M2Sym1 (d :: a))) (sM2 (sing @d)) - type T2aSym2 (a0123456789876543210 :: GHC.Types.Type) (b0123456789876543210 :: GHC.Types.Type) = - T2a a0123456789876543210 b0123456789876543210 - infixl 5 `T2aSym2` + instance SuppressUnusedWarnings T2aSym0 where + suppressUnusedWarnings = snd (((,) T2aSym0KindInference) ()) + data T2aSym0 a0123456789876543210 + where + T2aSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply T2aSym0 arg) (T2aSym1 arg) => + T2aSym0 a0123456789876543210 + type instance Apply T2aSym0 a0123456789876543210 = T2aSym1 a0123456789876543210 + infixl 5 `T2aSym0` instance SuppressUnusedWarnings (T2aSym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) T2aSym1KindInference) ()) data T2aSym1 (a0123456789876543210 :: GHC.Types.Type) b0123456789876543210 @@ -206,18 +212,18 @@ Singletons/T412.hs:0:0:: Splicing declarations T2aSym1 a0123456789876543210 b0123456789876543210 type instance Apply (T2aSym1 a0123456789876543210) b0123456789876543210 = T2aSym2 a0123456789876543210 b0123456789876543210 infixl 5 `T2aSym1` - instance SuppressUnusedWarnings T2aSym0 where - suppressUnusedWarnings = snd (((,) T2aSym0KindInference) ()) - data T2aSym0 a0123456789876543210 + type T2aSym2 (a0123456789876543210 :: GHC.Types.Type) (b0123456789876543210 :: GHC.Types.Type) = + T2a a0123456789876543210 b0123456789876543210 + infixl 5 `T2aSym2` + instance SuppressUnusedWarnings T2bSym0 where + suppressUnusedWarnings = snd (((,) T2bSym0KindInference) ()) + data T2bSym0 :: (~>) GHC.Types.Type ((~>) GHC.Types.Type GHC.Types.Type) where - T2aSym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply T2aSym0 arg) (T2aSym1 arg) => - T2aSym0 a0123456789876543210 - type instance Apply T2aSym0 a0123456789876543210 = T2aSym1 a0123456789876543210 - infixl 5 `T2aSym0` - type T2bSym2 (a0123456789876543210 :: GHC.Types.Type) (b0123456789876543210 :: GHC.Types.Type) = - T2b a0123456789876543210 b0123456789876543210 - infixl 5 `T2bSym2` + T2bSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply T2bSym0 arg) (T2bSym1 arg) => + T2bSym0 a0123456789876543210 + type instance Apply T2bSym0 a0123456789876543210 = T2bSym1 a0123456789876543210 + infixl 5 `T2bSym0` instance SuppressUnusedWarnings (T2bSym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) T2bSym1KindInference) ()) data T2bSym1 (a0123456789876543210 :: GHC.Types.Type) :: (~>) GHC.Types.Type GHC.Types.Type @@ -228,18 +234,20 @@ Singletons/T412.hs:0:0:: Splicing declarations T2bSym1 a0123456789876543210 b0123456789876543210 type instance Apply (T2bSym1 a0123456789876543210) b0123456789876543210 = T2bSym2 a0123456789876543210 b0123456789876543210 infixl 5 `T2bSym1` - instance SuppressUnusedWarnings T2bSym0 where - suppressUnusedWarnings = snd (((,) T2bSym0KindInference) ()) - data T2bSym0 :: (~>) GHC.Types.Type ((~>) GHC.Types.Type GHC.Types.Type) + type T2bSym2 (a0123456789876543210 :: GHC.Types.Type) (b0123456789876543210 :: GHC.Types.Type) = + T2b a0123456789876543210 b0123456789876543210 + infixl 5 `T2bSym2` + instance SuppressUnusedWarnings MkD2Sym0 where + suppressUnusedWarnings = snd (((,) MkD2Sym0KindInference) ()) + data MkD2Sym0 :: forall (a0123456789876543210 :: GHC.Types.Type) + (b0123456789876543210 :: GHC.Types.Type). + (~>) a0123456789876543210 ((~>) b0123456789876543210 (D2 (a0123456789876543210 :: GHC.Types.Type) (b0123456789876543210 :: GHC.Types.Type))) where - T2bSym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply T2bSym0 arg) (T2bSym1 arg) => - T2bSym0 a0123456789876543210 - type instance Apply T2bSym0 a0123456789876543210 = T2bSym1 a0123456789876543210 - infixl 5 `T2bSym0` - type MkD2Sym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) = - 'MkD2 t0123456789876543210 t0123456789876543210 - infixr 5 `MkD2Sym2` + MkD2Sym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply MkD2Sym0 arg) (MkD2Sym1 arg) => + MkD2Sym0 t0123456789876543210 + type instance Apply MkD2Sym0 t0123456789876543210 = MkD2Sym1 t0123456789876543210 + infixr 5 `MkD2Sym0` instance SuppressUnusedWarnings (MkD2Sym1 t0123456789876543210) where suppressUnusedWarnings = snd (((,) MkD2Sym1KindInference) ()) data MkD2Sym1 (t0123456789876543210 :: a0123456789876543210 :: GHC.Types.Type) :: forall (b0123456789876543210 :: GHC.Types.Type). @@ -251,17 +259,9 @@ Singletons/T412.hs:0:0:: Splicing declarations MkD2Sym1 t0123456789876543210 t0123456789876543210 type instance Apply (MkD2Sym1 t0123456789876543210) t0123456789876543210 = MkD2Sym2 t0123456789876543210 t0123456789876543210 infixr 5 `MkD2Sym1` - instance SuppressUnusedWarnings MkD2Sym0 where - suppressUnusedWarnings = snd (((,) MkD2Sym0KindInference) ()) - data MkD2Sym0 :: forall (a0123456789876543210 :: GHC.Types.Type) - (b0123456789876543210 :: GHC.Types.Type). - (~>) a0123456789876543210 ((~>) b0123456789876543210 (D2 (a0123456789876543210 :: GHC.Types.Type) (b0123456789876543210 :: GHC.Types.Type))) - where - MkD2Sym0KindInference :: forall t0123456789876543210 - arg. SameKind (Apply MkD2Sym0 arg) (MkD2Sym1 arg) => - MkD2Sym0 t0123456789876543210 - type instance Apply MkD2Sym0 t0123456789876543210 = MkD2Sym1 t0123456789876543210 - infixr 5 `MkD2Sym0` + type MkD2Sym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) = + 'MkD2 t0123456789876543210 t0123456789876543210 + infixr 5 `MkD2Sym2` data SD2 :: forall a b. D2 a b -> GHC.Types.Type where SMkD2 :: forall (a :: GHC.Types.Type) diff --git a/tests/compile-and-dump/Singletons/T414.golden b/tests/compile-and-dump/Singletons/T414.golden index f87e650b..5e01cf38 100644 --- a/tests/compile-and-dump/Singletons/T414.golden +++ b/tests/compile-and-dump/Singletons/T414.golden @@ -9,8 +9,14 @@ Singletons/T414.hs:(0,0)-(0,0): Splicing declarations type T1 a b class C2 a where type T2 a b - type T1Sym2 (a0123456789876543210 :: Bool) (b0123456789876543210 :: GHC.Types.Type) = - T1 a0123456789876543210 b0123456789876543210 + instance SuppressUnusedWarnings T1Sym0 where + suppressUnusedWarnings = snd (((,) T1Sym0KindInference) ()) + data T1Sym0 :: (~>) Bool ((~>) GHC.Types.Type GHC.Types.Type) + where + T1Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply T1Sym0 arg) (T1Sym1 arg) => + T1Sym0 a0123456789876543210 + type instance Apply T1Sym0 a0123456789876543210 = T1Sym1 a0123456789876543210 instance SuppressUnusedWarnings (T1Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) T1Sym1KindInference) ()) data T1Sym1 (a0123456789876543210 :: Bool) :: (~>) GHC.Types.Type GHC.Types.Type @@ -20,17 +26,17 @@ Singletons/T414.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (T1Sym1 a0123456789876543210) arg) (T1Sym2 a0123456789876543210 arg) => T1Sym1 a0123456789876543210 b0123456789876543210 type instance Apply (T1Sym1 a0123456789876543210) b0123456789876543210 = T1Sym2 a0123456789876543210 b0123456789876543210 - instance SuppressUnusedWarnings T1Sym0 where - suppressUnusedWarnings = snd (((,) T1Sym0KindInference) ()) - data T1Sym0 :: (~>) Bool ((~>) GHC.Types.Type GHC.Types.Type) - where - T1Sym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply T1Sym0 arg) (T1Sym1 arg) => - T1Sym0 a0123456789876543210 - type instance Apply T1Sym0 a0123456789876543210 = T1Sym1 a0123456789876543210 + type T1Sym2 (a0123456789876543210 :: Bool) (b0123456789876543210 :: GHC.Types.Type) = + T1 a0123456789876543210 b0123456789876543210 class PC1 (a :: Bool) - type T2Sym2 a0123456789876543210 b0123456789876543210 = - T2 a0123456789876543210 b0123456789876543210 + instance SuppressUnusedWarnings T2Sym0 where + suppressUnusedWarnings = snd (((,) T2Sym0KindInference) ()) + data T2Sym0 a0123456789876543210 + where + T2Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply T2Sym0 arg) (T2Sym1 arg) => + T2Sym0 a0123456789876543210 + type instance Apply T2Sym0 a0123456789876543210 = T2Sym1 a0123456789876543210 instance SuppressUnusedWarnings (T2Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) T2Sym1KindInference) ()) data T2Sym1 a0123456789876543210 b0123456789876543210 @@ -40,14 +46,8 @@ Singletons/T414.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (T2Sym1 a0123456789876543210) arg) (T2Sym2 a0123456789876543210 arg) => T2Sym1 a0123456789876543210 b0123456789876543210 type instance Apply (T2Sym1 a0123456789876543210) b0123456789876543210 = T2Sym2 a0123456789876543210 b0123456789876543210 - instance SuppressUnusedWarnings T2Sym0 where - suppressUnusedWarnings = snd (((,) T2Sym0KindInference) ()) - data T2Sym0 a0123456789876543210 - where - T2Sym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply T2Sym0 arg) (T2Sym1 arg) => - T2Sym0 a0123456789876543210 - type instance Apply T2Sym0 a0123456789876543210 = T2Sym1 a0123456789876543210 + type T2Sym2 a0123456789876543210 b0123456789876543210 = + T2 a0123456789876543210 b0123456789876543210 class PC2 a class SC1 (a :: Bool) class SC2 a diff --git a/tests/compile-and-dump/Singletons/T54.golden b/tests/compile-and-dump/Singletons/T54.golden index 72c6b302..7fb1fdb4 100644 --- a/tests/compile-and-dump/Singletons/T54.golden +++ b/tests/compile-and-dump/Singletons/T54.golden @@ -5,8 +5,6 @@ Singletons/T54.hs:(0,0)-(0,0): Splicing declarations ======> g :: Bool -> Bool g e = (case [not] of { [_] -> not }) e - type Let0123456789876543210Scrutinee_0123456789876543210Sym1 e0123456789876543210 = - Let0123456789876543210Scrutinee_0123456789876543210 e0123456789876543210 instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where suppressUnusedWarnings = snd @@ -19,11 +17,12 @@ Singletons/T54.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) => Let0123456789876543210Scrutinee_0123456789876543210Sym0 e0123456789876543210 type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 e0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210Sym1 e0123456789876543210 + type Let0123456789876543210Scrutinee_0123456789876543210Sym1 e0123456789876543210 = + Let0123456789876543210Scrutinee_0123456789876543210 e0123456789876543210 type family Let0123456789876543210Scrutinee_0123456789876543210 e where Let0123456789876543210Scrutinee_0123456789876543210 e = Apply (Apply (:@#@$) NotSym0) '[] type family Case_0123456789876543210 e t where Case_0123456789876543210 e '[_] = NotSym0 - type GSym1 (a0123456789876543210 :: Bool) = G a0123456789876543210 instance SuppressUnusedWarnings GSym0 where suppressUnusedWarnings = snd (((,) GSym0KindInference) ()) data GSym0 :: (~>) Bool Bool @@ -32,6 +31,7 @@ Singletons/T54.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply GSym0 arg) (GSym1 arg) => GSym0 a0123456789876543210 type instance Apply GSym0 a0123456789876543210 = GSym1 a0123456789876543210 + type GSym1 (a0123456789876543210 :: Bool) = G a0123456789876543210 type family G (a :: Bool) :: Bool where G e = Apply (Case_0123456789876543210 e (Let0123456789876543210Scrutinee_0123456789876543210Sym1 e)) e sG :: forall (t :: Bool). Sing t -> Sing (Apply GSym0 t :: Bool) diff --git a/tests/compile-and-dump/Singletons/T78.golden b/tests/compile-and-dump/Singletons/T78.golden index 00a75c26..8b3c7232 100644 --- a/tests/compile-and-dump/Singletons/T78.golden +++ b/tests/compile-and-dump/Singletons/T78.golden @@ -9,8 +9,6 @@ Singletons/T78.hs:(0,0)-(0,0): Splicing declarations foo (Just False) = False foo (Just True) = True foo Nothing = False - type FooSym1 (a0123456789876543210 :: Maybe Bool) = - Foo a0123456789876543210 instance SuppressUnusedWarnings FooSym0 where suppressUnusedWarnings = snd (((,) FooSym0KindInference) ()) data FooSym0 :: (~>) (Maybe Bool) Bool @@ -19,6 +17,8 @@ Singletons/T78.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) => FooSym0 a0123456789876543210 type instance Apply FooSym0 a0123456789876543210 = FooSym1 a0123456789876543210 + type FooSym1 (a0123456789876543210 :: Maybe Bool) = + Foo a0123456789876543210 type family Foo (a :: Maybe Bool) :: Bool where Foo ('Just 'False) = FalseSym0 Foo ('Just 'True) = TrueSym0 diff --git a/tests/compile-and-dump/Singletons/TopLevelPatterns.golden b/tests/compile-and-dump/Singletons/TopLevelPatterns.golden index 5f6872e6..d6509049 100644 --- a/tests/compile-and-dump/Singletons/TopLevelPatterns.golden +++ b/tests/compile-and-dump/Singletons/TopLevelPatterns.golden @@ -7,8 +7,15 @@ Singletons/TopLevelPatterns.hs:(0,0)-(0,0): Splicing declarations data Foo = Bar Bool Bool type FalseSym0 = False type TrueSym0 = True - type BarSym2 (t0123456789876543210 :: Bool) (t0123456789876543210 :: Bool) = - Bar t0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings BarSym0 where + suppressUnusedWarnings + = Data.Tuple.snd (((,) BarSym0KindInference) ()) + data BarSym0 :: (~>) Bool ((~>) Bool Foo) + where + BarSym0KindInference :: forall t0123456789876543210 + arg. SameKind (Apply BarSym0 arg) (BarSym1 arg) => + BarSym0 t0123456789876543210 + type instance Apply BarSym0 t0123456789876543210 = BarSym1 t0123456789876543210 instance SuppressUnusedWarnings (BarSym1 t0123456789876543210) where suppressUnusedWarnings = Data.Tuple.snd (((,) BarSym1KindInference) ()) @@ -19,15 +26,8 @@ Singletons/TopLevelPatterns.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (BarSym1 t0123456789876543210) arg) (BarSym2 t0123456789876543210 arg) => BarSym1 t0123456789876543210 t0123456789876543210 type instance Apply (BarSym1 t0123456789876543210) t0123456789876543210 = BarSym2 t0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings BarSym0 where - suppressUnusedWarnings - = Data.Tuple.snd (((,) BarSym0KindInference) ()) - data BarSym0 :: (~>) Bool ((~>) Bool Foo) - where - BarSym0KindInference :: forall t0123456789876543210 - arg. SameKind (Apply BarSym0 arg) (BarSym1 arg) => - BarSym0 t0123456789876543210 - type instance Apply BarSym0 t0123456789876543210 = BarSym1 t0123456789876543210 + type BarSym2 (t0123456789876543210 :: Bool) (t0123456789876543210 :: Bool) = + Bar t0123456789876543210 t0123456789876543210 data SBool :: Bool -> GHC.Types.Type where SFalse :: SBool (False :: Bool) @@ -131,7 +131,6 @@ Singletons/TopLevelPatterns.hs:(0,0)-(0,0): Splicing declarations type KSym0 = K type JSym0 = J type X_0123456789876543210Sym0 = X_0123456789876543210 - type ISym1 (a0123456789876543210 :: Bool) = I a0123456789876543210 instance SuppressUnusedWarnings ISym0 where suppressUnusedWarnings = Data.Tuple.snd (((,) ISym0KindInference) ()) @@ -141,7 +140,7 @@ Singletons/TopLevelPatterns.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply ISym0 arg) (ISym1 arg) => ISym0 a0123456789876543210 type instance Apply ISym0 a0123456789876543210 = ISym1 a0123456789876543210 - type HSym1 (a0123456789876543210 :: Bool) = H a0123456789876543210 + type ISym1 (a0123456789876543210 :: Bool) = I a0123456789876543210 instance SuppressUnusedWarnings HSym0 where suppressUnusedWarnings = Data.Tuple.snd (((,) HSym0KindInference) ()) @@ -151,8 +150,8 @@ Singletons/TopLevelPatterns.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply HSym0 arg) (HSym1 arg) => HSym0 a0123456789876543210 type instance Apply HSym0 a0123456789876543210 = HSym1 a0123456789876543210 + type HSym1 (a0123456789876543210 :: Bool) = H a0123456789876543210 type X_0123456789876543210Sym0 = X_0123456789876543210 - type GSym1 (a0123456789876543210 :: Bool) = G a0123456789876543210 instance SuppressUnusedWarnings GSym0 where suppressUnusedWarnings = Data.Tuple.snd (((,) GSym0KindInference) ()) @@ -162,7 +161,7 @@ Singletons/TopLevelPatterns.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply GSym0 arg) (GSym1 arg) => GSym0 a0123456789876543210 type instance Apply GSym0 a0123456789876543210 = GSym1 a0123456789876543210 - type FSym1 (a0123456789876543210 :: Bool) = F a0123456789876543210 + type GSym1 (a0123456789876543210 :: Bool) = G a0123456789876543210 instance SuppressUnusedWarnings FSym0 where suppressUnusedWarnings = Data.Tuple.snd (((,) FSym0KindInference) ()) @@ -172,10 +171,9 @@ Singletons/TopLevelPatterns.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply FSym0 arg) (FSym1 arg) => FSym0 a0123456789876543210 type instance Apply FSym0 a0123456789876543210 = FSym1 a0123456789876543210 + type FSym1 (a0123456789876543210 :: Bool) = F a0123456789876543210 type X_0123456789876543210Sym0 = X_0123456789876543210 type False_Sym0 = False_ - type NotSym1 (a0123456789876543210 :: Bool) = - Not a0123456789876543210 instance SuppressUnusedWarnings NotSym0 where suppressUnusedWarnings = Data.Tuple.snd (((,) NotSym0KindInference) ()) @@ -185,8 +183,8 @@ Singletons/TopLevelPatterns.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply NotSym0 arg) (NotSym1 arg) => NotSym0 a0123456789876543210 type instance Apply NotSym0 a0123456789876543210 = NotSym1 a0123456789876543210 - type IdSym1 (a0123456789876543210 :: a0123456789876543210) = - Id a0123456789876543210 + type NotSym1 (a0123456789876543210 :: Bool) = + Not a0123456789876543210 instance SuppressUnusedWarnings IdSym0 where suppressUnusedWarnings = Data.Tuple.snd (((,) IdSym0KindInference) ()) @@ -197,6 +195,8 @@ Singletons/TopLevelPatterns.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply IdSym0 arg) (IdSym1 arg) => IdSym0 a0123456789876543210 type instance Apply IdSym0 a0123456789876543210 = IdSym1 a0123456789876543210 + type IdSym1 (a0123456789876543210 :: a0123456789876543210) = + Id a0123456789876543210 type OtherwiseSym0 = Otherwise type family M :: Bool where M = Case_0123456789876543210 X_0123456789876543210Sym0 diff --git a/tests/compile-and-dump/Singletons/Undef.golden b/tests/compile-and-dump/Singletons/Undef.golden index 369c2816..9f80b4a1 100644 --- a/tests/compile-and-dump/Singletons/Undef.golden +++ b/tests/compile-and-dump/Singletons/Undef.golden @@ -9,8 +9,6 @@ Singletons/Undef.hs:(0,0)-(0,0): Splicing declarations foo = undefined bar :: Bool -> Bool bar = error "urk" - type BarSym1 (a0123456789876543210 :: Bool) = - Bar a0123456789876543210 instance SuppressUnusedWarnings BarSym0 where suppressUnusedWarnings = snd (((,) BarSym0KindInference) ()) data BarSym0 :: (~>) Bool Bool @@ -19,8 +17,8 @@ Singletons/Undef.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply BarSym0 arg) (BarSym1 arg) => BarSym0 a0123456789876543210 type instance Apply BarSym0 a0123456789876543210 = BarSym1 a0123456789876543210 - type FooSym1 (a0123456789876543210 :: Bool) = - Foo a0123456789876543210 + type BarSym1 (a0123456789876543210 :: Bool) = + Bar a0123456789876543210 instance SuppressUnusedWarnings FooSym0 where suppressUnusedWarnings = snd (((,) FooSym0KindInference) ()) data FooSym0 :: (~>) Bool Bool @@ -29,6 +27,8 @@ Singletons/Undef.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) => FooSym0 a0123456789876543210 type instance Apply FooSym0 a0123456789876543210 = FooSym1 a0123456789876543210 + type FooSym1 (a0123456789876543210 :: Bool) = + Foo a0123456789876543210 type family Bar (a :: Bool) :: Bool where Bar a_0123456789876543210 = Apply (Apply ErrorSym0 "urk") a_0123456789876543210 type family Foo (a :: Bool) :: Bool where