diff --git a/.travis.yml b/.travis.yml index b85a86d6..ccfbeb29 100644 --- a/.travis.yml +++ b/.travis.yml @@ -83,7 +83,7 @@ install: - "echo 'source-repository-package' >> cabal.project" - "echo ' type: git' >> cabal.project" - "echo ' location: https://github.com/goldfirere/th-desugar' >> cabal.project" - - "echo ' tag: 491028b6b33abe5e65a1b52cc019f07af6e890ef' >> cabal.project" + - "echo ' tag: c67e84d2f6fdfd2aab1af3a86f646a7cc805d668' >> cabal.project" - "echo 'package th-desugar' >> cabal.project" - "echo ' tests: False' >> cabal.project" - "echo ' benchmarks: False' >> cabal.project" @@ -115,7 +115,7 @@ script: - "echo 'source-repository-package' >> cabal.project" - "echo ' type: git' >> cabal.project" - "echo ' location: https://github.com/goldfirere/th-desugar' >> cabal.project" - - "echo ' tag: 491028b6b33abe5e65a1b52cc019f07af6e890ef' >> cabal.project" + - "echo ' tag: c67e84d2f6fdfd2aab1af3a86f646a7cc805d668' >> cabal.project" - "echo 'package th-desugar' >> cabal.project" - "echo ' tests: False' >> cabal.project" - "echo ' benchmarks: False' >> cabal.project" diff --git a/cabal.project b/cabal.project index 2fc95df0..06860f18 100644 --- a/cabal.project +++ b/cabal.project @@ -4,4 +4,4 @@ packages: . source-repository-package type: git location: https://github.com/goldfirere/th-desugar - tag: 491028b6b33abe5e65a1b52cc019f07af6e890ef + tag: c67e84d2f6fdfd2aab1af3a86f646a7cc805d668 diff --git a/src/Data/Singletons/Deriving/Util.hs b/src/Data/Singletons/Deriving/Util.hs index fb8fcfd3..57bd5d50 100644 --- a/src/Data/Singletons/Deriving/Util.hs +++ b/src/Data/Singletons/Deriving/Util.hs @@ -16,11 +16,11 @@ module Data.Singletons.Deriving.Util where import Control.Monad import Data.List -import qualified Data.Set as Set import Data.Singletons.Names import Data.Singletons.Syntax import Data.Singletons.Util import Language.Haskell.TH.Desugar +import qualified Language.Haskell.TH.Desugar.OSet as OSet import Language.Haskell.TH.Syntax -- A generic type signature for describing how to produce a derived instance. @@ -213,7 +213,7 @@ functorLikeValidityChecks allowConstrainedLastTyVar (DataDecl n data_tvbs cons) = do ex_tvbs <- conExistentialTvbs (foldTypeTvbs (DConT n) data_tvbs) con let univ_tvb_names = map extractTvbName con_tvbs \\ map extractTvbName ex_tvbs if last_tv `elem` univ_tvb_names - && last_tv `Set.notMember` foldMap fvDType con_theta + && last_tv `OSet.notMember` foldMap fvDType con_theta then pure () else fail $ badCon con_name existential | otherwise @@ -248,7 +248,7 @@ deepSubtypesContaining tv , ft_forall = \tvbs xs -> filter (\x -> all (not_in_ty x) tvbs) xs }) where not_in_ty :: DType -> DTyVarBndr -> Bool - not_in_ty ty tvb = extractTvbName tvb `Set.notMember` fvDType ty + not_in_ty ty tvb = extractTvbName tvb `OSet.notMember` fvDType ty -- Fold over the arguments of a data constructor in a Functor-like way. foldDataConArgs :: forall q a. DsMonad q => FFoldType a -> DCon -> q [a] diff --git a/src/Data/Singletons/Partition.hs b/src/Data/Singletons/Partition.hs index 6cfe62c1..54f77fc7 100644 --- a/src/Data/Singletons/Partition.hs +++ b/src/Data/Singletons/Partition.hs @@ -30,6 +30,8 @@ import Data.Singletons.Names import Language.Haskell.TH.Syntax hiding (showName) import Language.Haskell.TH.Ppr import Language.Haskell.TH.Desugar +import qualified Language.Haskell.TH.Desugar.OMap.Strict as OMap +import Language.Haskell.TH.Desugar.OMap.Strict (OMap) import Data.Singletons.Util import Control.Monad @@ -174,14 +176,14 @@ partitionClassDec _ = partitionInstanceDec :: Monad m => DDec -> m ( Maybe (Name, ULetDecRHS) -- right-hand sides of methods - , Map Name DType -- method type signatures + , OMap Name DType -- method type signatures ) partitionInstanceDec (DLetDec (DValD (DVarP name) exp)) = pure (Just (name, UValue exp), mempty) partitionInstanceDec (DLetDec (DFunD name clauses)) = pure (Just (name, UFunction clauses), mempty) partitionInstanceDec (DLetDec (DSigD name ty)) = - pure (Nothing, Map.singleton name ty) + pure (Nothing, OMap.singleton name ty) partitionInstanceDec (DLetDec (DPragmaD {})) = pure (Nothing, mempty) partitionInstanceDec (DTySynInstD {}) = diff --git a/src/Data/Singletons/Promote.hs b/src/Data/Singletons/Promote.hs index 63738b6a..1e9d2410 100644 --- a/src/Data/Singletons/Promote.hs +++ b/src/Data/Singletons/Promote.hs @@ -14,6 +14,10 @@ module Data.Singletons.Promote where import Language.Haskell.TH hiding ( Q, cxt ) import Language.Haskell.TH.Syntax ( Quasi(..) ) import Language.Haskell.TH.Desugar +import qualified Language.Haskell.TH.Desugar.OMap.Strict as OMap +import Language.Haskell.TH.Desugar.OMap.Strict (OMap) +import qualified Language.Haskell.TH.Desugar.OSet as OSet +import Language.Haskell.TH.Desugar.OSet (OSet) import Data.Singletons.Names import Data.Singletons.Promote.Monad import Data.Singletons.Promote.Eq @@ -35,8 +39,6 @@ import Control.Monad.Trans.Maybe import Control.Monad.Writer import qualified Data.Map.Strict as Map import Data.Map.Strict ( Map ) -import qualified Data.Set as Set -import Data.Set ( Set ) import Data.Maybe import qualified GHC.LanguageExtensions.Type as LangExt @@ -162,7 +164,7 @@ promoteInstance mk_inst class_name name = do cons' <- concatMapM (dsCon tvbs' data_ty) cons let data_decl = DataDecl name tvbs' cons' raw_inst <- mk_inst Nothing data_ty data_decl - decs <- promoteM_ [] $ void $ promoteInstanceDec Map.empty raw_inst + decs <- promoteM_ [] $ void $ promoteInstanceDec OMap.empty raw_inst return $ decsToTH decs promoteInfo :: DInfo -> PrM () @@ -255,12 +257,12 @@ promoteLetDecs prefixes decls = do let_dec_env <- buildLetDecEnv decls all_locals <- allLocals let binds = [ (name, foldType (DConT sym) (map DVarT all_locals)) - | name <- Map.keys $ lde_defns let_dec_env + | (name, _) <- OMap.assocs $ lde_defns let_dec_env , let proName = promoteValNameLhsPrefix prefixes name sym = promoteTySym proName (length all_locals) ] (decs, let_dec_env') <- letBind binds $ promoteLetDecEnv prefixes let_dec_env emitDecs decs - return (binds, let_dec_env' { lde_proms = Map.fromList binds }) + return (binds, let_dec_env' { lde_proms = OMap.fromList binds }) -- Promotion of data types to kinds is automatic (see "Giving Haskell a -- Promotion" paper for more details). Here we "plug into" the promotion @@ -310,14 +312,14 @@ promoteClassDec decl@(ClassDecl { cd_cxt = cxt let pClsName = promoteClassName cls_name pCxt <- mapM promote_superclass_pred cxt forallBind cls_kvs_to_bind $ do - sig_decs <- mapM (uncurry promote_sig) (Map.toList meth_sigs) - let defaults_list = Map.toList defaults + sig_decs <- mapM (uncurry promote_sig) (OMap.assocs meth_sigs) + let defaults_list = OMap.assocs defaults defaults_names = map fst defaults_list (default_decs, ann_rhss, prom_rhss) - <- mapAndUnzip3M (promoteMethod Map.empty Nothing meth_sigs) defaults_list + <- mapAndUnzip3M (promoteMethod OMap.empty Nothing meth_sigs) defaults_list let infix_decls' = catMaybes $ map (uncurry promoteInfixDecl) - $ Map.toList infix_decls + $ OMap.assocs infix_decls -- no need to do anything to the fundeps. They work as is! emitDecs [DClassD pCxt pClsName tvbs fundeps @@ -325,14 +327,14 @@ promoteClassDec decl@(ClassDecl { cd_cxt = cxt let defaults_list' = zip defaults_names ann_rhss proms = zip defaults_names prom_rhss cls_kvs_to_bind' = cls_kvs_to_bind <$ meth_sigs - return (decl { cd_lde = lde { lde_defns = Map.fromList defaults_list' - , lde_proms = Map.fromList proms + return (decl { cd_lde = lde { lde_defns = OMap.fromList defaults_list' + , lde_proms = OMap.fromList proms , lde_bound_kvs = cls_kvs_to_bind' } }) where - cls_kvb_names, cls_tvb_names, cls_kvs_to_bind :: Set Name + cls_kvb_names, cls_tvb_names, cls_kvs_to_bind :: OSet Name cls_kvb_names = foldMap (foldMap fvDType . extractTvbKind) tvbs' - cls_tvb_names = Set.fromList $ map extractTvbName tvbs' - cls_kvs_to_bind = cls_kvb_names `Set.union` cls_tvb_names + cls_tvb_names = OSet.fromList $ map extractTvbName tvbs' + cls_kvs_to_bind = cls_kvb_names OSet.|<> cls_tvb_names promote_sig :: Name -> DType -> PrM DDec promote_sig name ty = do @@ -362,7 +364,7 @@ promoteClassDec decl@(ClassDecl { cd_cxt = cxt go DArrowT = fail "(->) spotted at head of a constraint" -- returns (unpromoted method name, ALetDecRHS) pairs -promoteInstanceDec :: Map Name DType -> UInstDecl -> PrM AInstDecl +promoteInstanceDec :: OMap Name DType -> UInstDecl -> PrM AInstDecl promoteInstanceDec orig_meth_sigs decl@(InstDecl { id_name = cls_name , id_arg_tys = inst_tys @@ -432,11 +434,11 @@ dsReifyTypeNameInfo, which first calls lookupTypeName (to ensure we can find a N that's in the type namespace) and _then_ reifies it. -} -promoteMethod :: Map Name DType -- InstanceSigs for methods +promoteMethod :: OMap Name DType -- InstanceSigs for methods -> Maybe (Map Name DKind) -- ^ instantiations for class tyvars (Nothing for default decls) -- See Note [Promoted class method kinds] - -> Map Name DType -- method types + -> OMap Name DType -- method types -> (Name, ULetDecRHS) -> PrM (DDec, ALetDecRHS, DType) -- returns (type instance, ALetDecRHS, promoted RHS) @@ -462,7 +464,7 @@ promoteMethod inst_sigs_map m_subst orig_sigs_map (meth_name, meth_rhs) = do family_args = map DVarT meth_arg_tvs helperName <- newUniqueName helperNameBase ((_, _, _, eqns), _defuns, ann_rhs) - <- promoteLetDecRHS (Just (meth_arg_kis, meth_res_ki)) Map.empty Map.empty + <- promoteLetDecRHS (Just (meth_arg_kis, meth_res_ki)) OMap.empty OMap.empty noPrefix helperName meth_rhs let tvbs = zipWith DKindedTV meth_arg_tvs meth_arg_kis emitDecs [DClosedTypeFamilyD (DTypeFamilyHead @@ -483,7 +485,7 @@ promoteMethod inst_sigs_map m_subst orig_sigs_map (meth_name, meth_rhs) = do lookup_meth_ty :: PrM ([DKind], DKind) lookup_meth_ty = - case Map.lookup meth_name inst_sigs_map of + case OMap.lookup meth_name inst_sigs_map of Just ty -> -- We have an InstanceSig. These are easy: no substitution for clas -- variables is required at all! @@ -492,7 +494,7 @@ promoteMethod inst_sigs_map m_subst orig_sigs_map (meth_name, meth_rhs) = do -- We don't have an InstanceSig, so we must compute the kind to use -- ourselves (possibly substituting for class variables below). (arg_kis, res_ki) <- - case Map.lookup meth_name orig_sigs_map of + case OMap.lookup meth_name orig_sigs_map of Nothing -> do mb_info <- dsReifyTypeNameInfo proName -- See Note [Using dsReifyTypeNameInfo when promoting instances] @@ -553,10 +555,10 @@ promoteLetDecEnv prefixes (LetDecEnv { lde_defns = value_env , lde_types = type_env , lde_infix = fix_env }) = do let infix_decls = catMaybes $ map (uncurry promoteInfixDecl) - $ Map.toList fix_env + $ OMap.assocs fix_env -- promote all the declarations, producing annotated declarations - let (names, rhss) = unzip $ Map.toList value_env + let (names, rhss) = unzip $ OMap.assocs value_env (payloads, defun_decss, ann_rhss) <- fmap unzip3 $ zipWithM (promoteLetDecRHS Nothing type_env fix_env prefixes) names rhss @@ -565,11 +567,11 @@ promoteLetDecEnv prefixes (LetDecEnv { lde_defns = value_env let decs = map payload_to_dec payloads ++ infix_decls -- build the ALetDecEnv - let let_dec_env' = LetDecEnv { lde_defns = Map.fromList $ zip names ann_rhss + let let_dec_env' = LetDecEnv { lde_defns = OMap.fromList $ zip names ann_rhss , lde_types = type_env , lde_infix = fix_env - , lde_proms = Map.empty -- filled in promoteLetDecs - , lde_bound_kvs = Map.fromList $ map (, bound_kvs) names } + , lde_proms = OMap.empty -- filled in promoteLetDecs + , lde_bound_kvs = OMap.fromList $ map (, bound_kvs) names } return (decs, let_dec_env') where @@ -601,8 +603,8 @@ promoteInfixDecl name fixity -- an intermediate structure. Perhaps a better design is available. promoteLetDecRHS :: Maybe ([DKind], DKind) -- the promoted type of the RHS (if known) -- needed to fix #136 - -> Map Name DType -- local type env't - -> Map Name Fixity -- local fixity env't + -> OMap Name DType -- local type env't + -> OMap Name Fixity -- local fixity env't -> (String, String) -- let-binding prefixes -> Name -- name of the thing being promoted -> ULetDecRHS -- body of the thing @@ -614,7 +616,7 @@ promoteLetDecRHS m_rhs_ki type_env fix_env prefixes name (UValue exp) = do <- case m_rhs_ki of Just (arg_kis, res_ki) -> return ( Just (ravelTyFun (arg_kis ++ [res_ki])) , length arg_kis ) - _ | Just ty <- Map.lookup name type_env + _ | Just ty <- OMap.lookup name type_env -> do ki <- promoteType ty return (Just ki, countArgs ty) | otherwise @@ -625,7 +627,7 @@ promoteLetDecRHS m_rhs_ki type_env fix_env prefixes name (UValue exp) = do let lde_kvs_to_bind = foldMap fvDType res_kind (exp', ann_exp) <- forallBind lde_kvs_to_bind $ promoteExp exp let proName = promoteValNameLhsPrefix prefixes name - m_fixity = Map.lookup name fix_env + m_fixity = OMap.lookup name fix_env tvbs = map DPlainTV all_locals defuns <- defunctionalize proName m_fixity tvbs res_kind return ( ( proName, tvbs, res_kind @@ -644,7 +646,7 @@ promoteLetDecRHS m_rhs_ki type_env fix_env prefixes name (UFunction clauses) = d numArgs <- count_args clauses (m_argKs, m_resK, ty_num_args) <- case m_rhs_ki of Just (arg_kis, res_ki) -> return (map Just arg_kis, Just res_ki, length arg_kis) - _ | Just ty <- Map.lookup name type_env + _ | Just ty <- OMap.lookup name type_env -> do -- promoteType turns arrows into TyFun. So, we unravel first to -- avoid this behavior. Note the use of ravelTyFun in resultK @@ -656,7 +658,7 @@ promoteLetDecRHS m_rhs_ki type_env fix_env prefixes name (UFunction clauses) = d | otherwise -> return (replicate numArgs Nothing, Nothing, numArgs) let proName = promoteValNameLhsPrefix prefixes name - m_fixity = Map.lookup name fix_env + m_fixity = OMap.lookup name fix_env all_locals <- allLocals let local_tvbs = map DPlainTV all_locals tyvarNames <- mapM (const $ qNewName "a") m_argKs @@ -726,7 +728,7 @@ promotePat (DLitP lit) = (, ADLitP lit) <$> promoteLitPat lit promotePat (DVarP name) = do -- term vars can be symbols... type vars can't! tyName <- mkTyName name - tell $ PromDPatInfos [(name, tyName)] Set.empty + tell $ PromDPatInfos [(name, tyName)] OSet.empty return (DVarT tyName, ADVarP name) promotePat (DConP name pats) = do (types, pats') <- mapAndUnzipM promotePat pats diff --git a/src/Data/Singletons/Promote/Defun.hs b/src/Data/Singletons/Promote/Defun.hs index f06a3018..daccef32 100644 --- a/src/Data/Singletons/Promote/Defun.hs +++ b/src/Data/Singletons/Promote/Defun.hs @@ -11,6 +11,7 @@ This file creates defunctionalization symbols for types during promotion. module Data.Singletons.Promote.Defun where import Language.Haskell.TH.Desugar +import qualified Language.Haskell.TH.Desugar.OSet as OSet import Data.Singletons.Promote.Monad import Data.Singletons.Promote.Type import Data.Singletons.Names @@ -18,10 +19,10 @@ import Language.Haskell.TH.Syntax import Data.Singletons.Syntax import Data.Singletons.Util import Control.Monad +import Data.Foldable import qualified Data.Map.Strict as Map import Data.Map.Strict (Map) import Data.Maybe -import qualified Data.Set as Set defunInfo :: DInfo -> PrM [DDec] defunInfo (DTyConI dec _instances) = buildDefunSyms dec @@ -193,17 +194,17 @@ defunctionalize name m_fixity m_arg_tvbs' m_res_kind' = do -- If we cannot infer the return type, don't bother -- trying to construct an explicit return kind. Just tyfun -> - let bound_tvs = Set.fromList (map extractTvbName arg_params) `Set.union` + let bound_tvs = OSet.fromList (map extractTvbName arg_params) OSet.|<> foldMap (foldMap fvDType) (map extractTvbKind arg_params) - not_bound tvb = not (extractTvbName tvb `Set.member` bound_tvs) + not_bound tvb = not (extractTvbName tvb `OSet.member` bound_tvs) tvb_to_type tvb_name = fromMaybe (DVarT tvb_name) $ Map.lookup tvb_name tvb_to_type_map -- Implements part (2)(iii) from -- Note [Defunctionalization and dependent quantification] - tyfun_tvbs = filter not_bound $ -- (2)(iii)(d) - toposortTyVarsOf $ -- (2)(iii)(c) - map tvb_to_type $ -- (2)(iii)(b) - Set.toList $ fvDType tyfun -- (2)(iii)(a) + tyfun_tvbs = filter not_bound $ -- (2)(iii)(d) + toposortTyVarsOf $ -- (2)(iii)(c) + map tvb_to_type $ -- (2)(iii)(b) + toList $ fvDType tyfun -- (2)(iii)(a) in (arg_params, Just (DForallT tyfun_tvbs [] tyfun)) app_data_ty = foldTypeTvbs (DConT data_name) m_args app_eqn = DTySynEqn Nothing diff --git a/src/Data/Singletons/Promote/Monad.hs b/src/Data/Singletons/Promote/Monad.hs index 09a02aea..ff12dd5b 100644 --- a/src/Data/Singletons/Promote/Monad.hs +++ b/src/Data/Singletons/Promote/Monad.hs @@ -20,30 +20,30 @@ module Data.Singletons.Promote.Monad ( import Control.Monad.Reader import Control.Monad.Writer -import qualified Data.Map.Strict as Map -import Data.Map.Strict ( Map ) -import qualified Data.Set as Set -import Data.Set ( Set ) import Language.Haskell.TH.Syntax hiding ( lift ) import Language.Haskell.TH.Desugar +import qualified Language.Haskell.TH.Desugar.OMap.Strict as OMap +import Language.Haskell.TH.Desugar.OMap.Strict (OMap) +import qualified Language.Haskell.TH.Desugar.OSet as OSet +import Language.Haskell.TH.Desugar.OSet (OSet) import Data.Singletons.Names import Data.Singletons.Syntax import Control.Monad.Fail ( MonadFail ) -type LetExpansions = Map Name DType -- from **term-level** name +type LetExpansions = OMap Name DType -- from **term-level** name -- environment during promotion data PrEnv = - PrEnv { pr_lambda_bound :: Map Name Name + PrEnv { pr_lambda_bound :: OMap Name Name , pr_let_bound :: LetExpansions - , pr_forall_bound :: Set Name -- See Note [Explicitly quantifying kinds variables] + , pr_forall_bound :: OSet Name -- See Note [Explicitly quantifying kinds variables] , pr_local_decls :: [Dec] } emptyPrEnv :: PrEnv -emptyPrEnv = PrEnv { pr_lambda_bound = Map.empty - , pr_let_bound = Map.empty - , pr_forall_bound = Set.empty +emptyPrEnv = PrEnv { pr_lambda_bound = OMap.empty + , pr_let_bound = OMap.empty + , pr_forall_bound = OSet.empty , pr_local_decls = [] } -- the promotion monad @@ -58,12 +58,12 @@ instance DsMonad PrM where -- return *type-level* names allLocals :: MonadReader PrEnv m => m [Name] allLocals = do - lambdas <- asks (Map.toList . pr_lambda_bound) + lambdas <- asks (OMap.assocs . pr_lambda_bound) lets <- asks pr_let_bound -- filter out shadowed variables! return [ typeName | (termName, typeName) <- lambdas - , case Map.lookup termName lets of + , case OMap.lookup termName lets of Just (DVarT typeName') | typeName' == typeName -> True _ -> False ] @@ -81,33 +81,33 @@ lambdaBind :: VarPromotions -> PrM a -> PrM a lambdaBind binds = local add_binds where add_binds env@(PrEnv { pr_lambda_bound = lambdas , pr_let_bound = lets }) = - let new_lets = Map.fromList [ (tmN, DVarT tyN) | (tmN, tyN) <- binds ] in - env { pr_lambda_bound = Map.union (Map.fromList binds) lambdas - , pr_let_bound = Map.union new_lets lets } + let new_lets = OMap.fromList [ (tmN, DVarT tyN) | (tmN, tyN) <- binds ] in + env { pr_lambda_bound = OMap.fromList binds OMap.|<> lambdas + , pr_let_bound = new_lets OMap.|<> lets } type LetBind = (Name, DType) letBind :: [LetBind] -> PrM a -> PrM a letBind binds = local add_binds where add_binds env@(PrEnv { pr_let_bound = lets }) = - env { pr_let_bound = Map.union (Map.fromList binds) lets } + env { pr_let_bound = OMap.fromList binds OMap.|<> lets } lookupVarE :: Name -> PrM DType lookupVarE n = do lets <- asks pr_let_bound - case Map.lookup n lets of + case OMap.lookup n lets of Just ty -> return ty Nothing -> return $ promoteValRhs n -- Add to the set of bound kind variables currently in scope. -- See Note [Explicitly binding kind variables] -forallBind :: Set Name -> PrM a -> PrM a +forallBind :: OSet Name -> PrM a -> PrM a forallBind kvs1 = local (\env@(PrEnv { pr_forall_bound = kvs2 }) -> - env { pr_forall_bound = kvs1 `Set.union` kvs2 }) + env { pr_forall_bound = kvs1 OSet.|<> kvs2 }) -- Look up the set of bound kind variables currently in scope. -- See Note [Explicitly binding kind variables] -allBoundKindVars :: PrM (Set Name) +allBoundKindVars :: PrM (OSet Name) allBoundKindVars = asks pr_forall_bound promoteM :: DsMonad q => [Dec] -> PrM a -> q (a, [DDec]) diff --git a/src/Data/Singletons/Single.hs b/src/Data/Singletons/Single.hs index 0d4251d9..e41575ab 100644 --- a/src/Data/Singletons/Single.hs +++ b/src/Data/Singletons/Single.hs @@ -34,11 +34,14 @@ import Data.Singletons.Single.Eq import Data.Singletons.Syntax import Data.Singletons.Partition import Language.Haskell.TH.Desugar +import qualified Language.Haskell.TH.Desugar.OMap.Strict as OMap +import Language.Haskell.TH.Desugar.OMap.Strict (OMap) +import qualified Language.Haskell.TH.Desugar.OSet as OSet +import Language.Haskell.TH.Desugar.OSet (OSet) import qualified Data.Map.Strict as Map import Data.Map.Strict ( Map ) import Data.Maybe import qualified Data.Set as Set -import Data.Set ( Set ) import Control.Monad import Data.List import qualified GHC.LanguageExtensions.Type as LangExt @@ -269,7 +272,7 @@ singInstance mk_inst inst_name name = do let data_decl = DataDecl name dtvbs dcons raw_inst <- mk_inst Nothing data_ty data_decl (a_inst, decs) <- promoteM [] $ - promoteInstanceDec Map.empty raw_inst + promoteInstanceDec OMap.empty raw_inst decs' <- singDecsM [] $ (:[]) <$> singInstD a_inst return $ decsToTH (decs ++ decs') @@ -346,7 +349,7 @@ buildDataLets (DataDecl _name _tvbs cons) = -- see comment at top of file buildMethLets :: UClassDecl -> [(Name, DExp)] buildMethLets (ClassDecl { cd_lde = LetDecEnv { lde_types = meth_sigs } }) = - map mk_bind (Map.toList meth_sigs) + map mk_bind (OMap.assocs meth_sigs) where mk_bind (meth_name, meth_ty) = ( meth_name @@ -375,8 +378,8 @@ singClassD (ClassDecl { cd_cxt = cls_cxt sing_meths <- mapM (uncurry (singLetDecRHS (Map.fromList tyvar_names) (Map.fromList cxts) res_ki_map)) - (Map.toList default_defns) - fixities' <- traverse (uncurry singInfixDecl) $ Map.toList fixities + (OMap.assocs default_defns) + fixities' <- traverse (uncurry singInfixDecl) $ OMap.assocs fixities cls_cxt' <- mapM singPred cls_cxt return $ DClassD cls_cxt' (singClassName cls_name) @@ -386,14 +389,14 @@ singClassD (ClassDecl { cd_cxt = cls_cxt where no_meth_defns = error "Internal error: can't find declared method type" always_sig = error "Internal error: no signature for default method" - meth_names = Map.keys meth_sigs + meth_names = map fst $ OMap.assocs meth_sigs mk_default_sig meth_name (DSigD s_name sty) bound_kvs (Just res_ki) = DDefaultSigD s_name <$> add_constraints meth_name sty bound_kvs res_ki mk_default_sig _ _ _ _ = error "Internal error: a singled signature isn't a signature." add_constraints meth_name sty (_, bound_kvs) res_ki = do -- Maybe monad - prom_dflt <- Map.lookup meth_name promoted_defaults + prom_dflt <- OMap.lookup meth_name promoted_defaults let default_pred = foldType (DConT equalityName) -- NB: Need the res_ki here to prevent ambiguous -- kinds in result-inferred default methods. @@ -455,7 +458,7 @@ singInstD (InstDecl { id_cxt = cxt, id_name = inst_name, id_arg_tys = inst_tys -- less confusing. vis_cls_tvbs = drop (length cls_tvbs - length inst_kis) cls_tvbs - sing_meth_ty :: Set Name -> DType + sing_meth_ty :: OSet Name -> DType -> SgM (DType, [Name], DCxt, DKind) sing_meth_ty bound_kvs inner_ty = do -- Make sure to expand through type synonyms here! Not doing so @@ -465,7 +468,7 @@ singInstD (InstDecl { id_cxt = cxt, id_name = inst_name, id_arg_tys = inst_tys <- singType bound_kvs (promoteValRhs name) raw_ty pure (s_ty, tyvar_names, ctxt, res_ki) - (s_ty, tyvar_names, ctxt, m_res_ki) <- case Map.lookup name inst_sigs of + (s_ty, tyvar_names, ctxt, m_res_ki) <- case OMap.lookup name inst_sigs of Just inst_sig -> do -- We have an InstanceSig, so just single that type. Take care to -- avoid binding the variables bound by the instance head as well. @@ -492,8 +495,8 @@ singInstD (InstDecl { id_cxt = cxt, id_name = inst_name, id_arg_tys = inst_tys Just (DVarI _ (DForallT cls_tvbs _cls_pred inner_ty) _) -> do let subst = mk_subst cls_tvbs cls_kvb_names = foldMap (foldMap fvDType . extractTvbKind) cls_tvbs - cls_tvb_names = Set.fromList $ map extractTvbName cls_tvbs - cls_bound = cls_kvb_names `Set.union` cls_tvb_names + cls_tvb_names = OSet.fromList $ map extractTvbName cls_tvbs + cls_bound = cls_kvb_names OSet.|<> cls_tvb_names (s_ty, tyvar_names, ctxt, res_ki) <- sing_meth_ty cls_bound inner_ty pure ( substType subst s_ty , tyvar_names @@ -522,23 +525,23 @@ singLetDecEnv (LetDecEnv { lde_defns = defns , lde_proms = proms , lde_bound_kvs = bound_kvs }) thing_inside = do - let prom_list = Map.toList proms + let prom_list = OMap.assocs proms (typeSigs, letBinds, tyvarNames, cxts, res_kis, singIDefunss) <- unzip6 <$> mapM (uncurry (singTySig defns types bound_kvs)) prom_list - infix_decls' <- traverse (uncurry singInfixDecl) $ Map.toList infix_decls + infix_decls' <- traverse (uncurry singInfixDecl) $ OMap.assocs infix_decls let res_ki_map = Map.fromList [ (name, res_ki) | ((name, _), Just res_ki) <- zip prom_list res_kis ] bindLets letBinds $ do let_decs <- mapM (uncurry (singLetDecRHS (Map.fromList tyvarNames) (Map.fromList cxts) res_ki_map)) - (Map.toList defns) + (OMap.assocs defns) thing <- thing_inside return (infix_decls' ++ typeSigs ++ let_decs, concat singIDefunss, thing) -singTySig :: Map Name ALetDecRHS -- definitions - -> Map Name DType -- type signatures - -> Map Name (Set Name) -- bound kind variables +singTySig :: OMap Name ALetDecRHS -- definitions + -> OMap Name DType -- type signatures + -> OMap Name (OSet Name) -- bound kind variables -> Name -> DType -- the type is the promoted type, not the type sig! -> SgM ( DLetDec -- the new type signature , (Name, DExp) -- the let-bind entry @@ -549,7 +552,7 @@ singTySig :: Map Name ALetDecRHS -- definitions ) singTySig defns types bound_kvs name prom_ty = let sName = singValName name in - case Map.lookup name types of + case OMap.lookup name types of Nothing -> do num_args <- guess_num_args (sty, tyvar_names) <- mk_sing_ty num_args @@ -577,14 +580,14 @@ singTySig defns types bound_kvs name prom_ty = where guess_num_args :: SgM Int guess_num_args = - case Map.lookup name defns of + case OMap.lookup name defns of Nothing -> fail "Internal error: promotion known for something not let-bound." Just (AValue _ n _) -> return n Just (AFunction _ n _) -> return n - lookup_bound_kvs :: SgM (Set Name) + lookup_bound_kvs :: SgM (OSet Name) lookup_bound_kvs = - case Map.lookup name bound_kvs of + case OMap.lookup name bound_kvs of Nothing -> fail $ "Internal error: " ++ nameBase name ++ " has no type variable " ++ "bindings, despite having a type signature" Just kvs -> pure kvs diff --git a/src/Data/Singletons/Single/Data.hs b/src/Data/Singletons/Single/Data.hs index 5f980c04..a0c33e53 100644 --- a/src/Data/Singletons/Single/Data.hs +++ b/src/Data/Singletons/Single/Data.hs @@ -11,6 +11,7 @@ Singletonizes constructors. module Data.Singletons.Single.Data where import Language.Haskell.TH.Desugar +import Language.Haskell.TH.Desugar.OSet (OSet) import Language.Haskell.TH.Syntax import Data.Singletons.Single.Defun import Data.Singletons.Single.Monad @@ -21,8 +22,7 @@ import Data.Singletons.Util import Data.Singletons.Names import Data.Singletons.Syntax import Control.Monad -import qualified Data.Set as Set -import Data.Set (Set) +import Data.Foldable -- We wish to consider the promotion of "Rep" to be * -- not a promoted data constructor. @@ -147,7 +147,7 @@ singCtor (DCon _tvbs cxt name fields rty) let bound_kvs = foldMap fvDType kinds args <- zipWithM (buildArgType bound_kvs) types indices rty' <- promoteType rty - let tvbs = map DPlainTV (Set.toList bound_kvs) ++ zipWith DKindedTV indexNames kinds + let tvbs = map DPlainTV (toList bound_kvs) ++ zipWith DKindedTV indexNames kinds kindedIndices = zipWith DSigT indices kinds -- SingI instance for data constructor @@ -175,7 +175,7 @@ singCtor (DCon _tvbs cxt name fields rty) sName conFields (DConT singFamilyName `DAppT` foldType pCon indices) - where buildArgType :: Set Name -> DType -> DType -> SgM DType + where buildArgType :: OSet Name -> DType -> DType -> SgM DType buildArgType bound_kvs ty index = do (ty', _, _, _, _, _) <- singType bound_kvs index ty return ty' diff --git a/src/Data/Singletons/Single/Type.hs b/src/Data/Singletons/Single/Type.hs index d5dffc07..33532c17 100644 --- a/src/Data/Singletons/Single/Type.hs +++ b/src/Data/Singletons/Single/Type.hs @@ -9,16 +9,17 @@ Singletonizes types. module Data.Singletons.Single.Type where import Language.Haskell.TH.Desugar +import qualified Language.Haskell.TH.Desugar.OSet as OSet +import Language.Haskell.TH.Desugar.OSet (OSet) import Language.Haskell.TH.Syntax import Data.Singletons.Names import Data.Singletons.Single.Monad import Data.Singletons.Promote.Type import Data.Singletons.Util import Control.Monad -import qualified Data.Set as Set -import Data.Set (Set) +import Data.Foldable -singType :: Set Name -- the set of bound kind variables in this scope +singType :: OSet Name -- the set of bound kind variables in this scope -- see Note [Explicitly binding kind variables] -- in Data.Singletons.Promote.Monad -> DType -- the promoted version of the thing classified by... @@ -42,8 +43,8 @@ singType bound_kvs prom ty = do -- Make sure to subtract out the bound variables currently in scope, lest we -- accidentally shadow them in this type signature. kv_names_to_bind = foldMap fvDType (prom_args ++ cxt' ++ [prom_res]) - Set.\\ bound_kvs - kvs_to_bind = Set.toList kv_names_to_bind + OSet.\\ bound_kvs + kvs_to_bind = toList kv_names_to_bind let ty' = DForallT (map DPlainTV kvs_to_bind ++ zipWith DKindedTV arg_names prom_args) cxt' tau return (ty', num_args, arg_names, cxt, prom_args, prom_res) diff --git a/src/Data/Singletons/Syntax.hs b/src/Data/Singletons/Syntax.hs index cf17bd16..254aca0c 100644 --- a/src/Data/Singletons/Syntax.hs +++ b/src/Data/Singletons/Syntax.hs @@ -16,9 +16,9 @@ import Prelude hiding ( exp ) import Data.Kind (Constraint, Type) import Language.Haskell.TH.Syntax hiding (Type) import Language.Haskell.TH.Desugar -import Data.Map.Strict ( Map ) -import qualified Data.Map.Strict as Map -import Data.Set ( Set ) +import qualified Language.Haskell.TH.Desugar.OMap.Strict as OMap +import Language.Haskell.TH.Desugar.OMap.Strict (OMap) +import Language.Haskell.TH.Desugar.OSet (OSet) type VarPromotions = [(Name, Name)] -- from term-level name to type-level name @@ -26,7 +26,7 @@ type VarPromotions = [(Name, Name)] -- from term-level name to type-level name data PromDPatInfos = PromDPatInfos { prom_dpat_vars :: VarPromotions -- Maps term-level pattern variables to their promoted, type-level counterparts. - , prom_dpat_sig_kvs :: Set Name + , prom_dpat_sig_kvs :: OSet Name -- Kind variables bound by DSigPas. -- See Note [Explicitly binding kind variables] in Data.Singletons.Promote.Monad } @@ -72,7 +72,7 @@ data ClassDecl ann = ClassDecl { cd_cxt :: DCxt data InstDecl ann = InstDecl { id_cxt :: DCxt , id_name :: Name , id_arg_tys :: [DType] - , id_sigs :: Map Name DType + , id_sigs :: OMap Name DType , id_meths :: [(Name, LetDecRHS ann)] } type UClassDecl = ClassDecl Unannotated @@ -144,11 +144,11 @@ type ALetDecRHS = LetDecRHS Annotated type ULetDecRHS = LetDecRHS Unannotated data LetDecEnv ann = LetDecEnv - { lde_defns :: Map Name (LetDecRHS ann) - , lde_types :: Map Name DType -- type signatures - , lde_infix :: Map Name Fixity -- infix declarations - , lde_proms :: IfAnn ann (Map Name DType) () -- possibly, promotions - , lde_bound_kvs :: IfAnn ann (Map Name (Set Name)) () + { lde_defns :: OMap Name (LetDecRHS ann) + , lde_types :: OMap Name DType -- type signatures + , lde_infix :: OMap Name Fixity -- infix declarations + , lde_proms :: IfAnn ann (OMap Name DType) () -- possibly, promotions + , lde_bound_kvs :: IfAnn ann (OMap Name (OSet Name)) () -- The set of bound variables in scope. -- See Note [Explicitly binding kind variables] -- in Data.Singletons.Promote.Monad @@ -161,16 +161,16 @@ instance Semigroup ULetDecEnv where LetDecEnv (defns1 <> defns2) (types1 <> types2) (infx1 <> infx2) () () instance Monoid ULetDecEnv where - mempty = LetDecEnv Map.empty Map.empty Map.empty () () + mempty = LetDecEnv OMap.empty OMap.empty OMap.empty () () valueBinding :: Name -> ULetDecRHS -> ULetDecEnv -valueBinding n v = emptyLetDecEnv { lde_defns = Map.singleton n v } +valueBinding n v = emptyLetDecEnv { lde_defns = OMap.singleton n v } typeBinding :: Name -> DType -> ULetDecEnv -typeBinding n t = emptyLetDecEnv { lde_types = Map.singleton n t } +typeBinding n t = emptyLetDecEnv { lde_types = OMap.singleton n t } infixDecl :: Fixity -> Name -> ULetDecEnv -infixDecl f n = emptyLetDecEnv { lde_infix = Map.singleton n f } +infixDecl f n = emptyLetDecEnv { lde_infix = OMap.singleton n f } emptyLetDecEnv :: ULetDecEnv emptyLetDecEnv = mempty diff --git a/tests/SingletonsTestSuite.hs b/tests/SingletonsTestSuite.hs index 69994a38..07709599 100644 --- a/tests/SingletonsTestSuite.hs +++ b/tests/SingletonsTestSuite.hs @@ -114,6 +114,7 @@ tests = , compileAndDumpStdTest "FunctorLikeDeriving" , compileAndDumpStdTest "T353" , compileAndDumpStdTest "T358" + , compileAndDumpStdTest "T367" , compileAndDumpStdTest "T371" , compileAndDumpStdTest "T376" ], diff --git a/tests/compile-and-dump/GradingClient/Database.ghc86.template b/tests/compile-and-dump/GradingClient/Database.ghc86.template index 88bd10b1..3e4bea5b 100644 --- a/tests/compile-and-dump/GradingClient/Database.ghc86.template +++ b/tests/compile-and-dump/GradingClient/Database.ghc86.template @@ -397,25 +397,6 @@ GradingClient/Database.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply OccursSym0 arg) (OccursSym1 arg) => OccursSym0 a0123456789876543210 type instance Apply OccursSym0 a0123456789876543210 = OccursSym1 a0123456789876543210 - type AttrNotInSym2 (a0123456789876543210 :: Attribute) (a0123456789876543210 :: Schema) = - AttrNotIn a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (AttrNotInSym1 a0123456789876543210) where - suppressUnusedWarnings = snd (((,) AttrNotInSym1KindInference) ()) - data AttrNotInSym1 (a0123456789876543210 :: Attribute) :: (~>) Schema Bool - where - AttrNotInSym1KindInference :: forall a0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply (AttrNotInSym1 a0123456789876543210) arg) (AttrNotInSym2 a0123456789876543210 arg) => - AttrNotInSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (AttrNotInSym1 a0123456789876543210) a0123456789876543210 = AttrNotIn a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings AttrNotInSym0 where - suppressUnusedWarnings = snd (((,) AttrNotInSym0KindInference) ()) - data AttrNotInSym0 :: (~>) Attribute ((~>) Schema Bool) - where - AttrNotInSym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply AttrNotInSym0 arg) (AttrNotInSym1 arg) => - AttrNotInSym0 a0123456789876543210 - type instance Apply AttrNotInSym0 a0123456789876543210 = AttrNotInSym1 a0123456789876543210 type DisjointSym2 (a0123456789876543210 :: Schema) (a0123456789876543210 :: Schema) = Disjoint a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (DisjointSym1 a0123456789876543210) where @@ -435,6 +416,25 @@ GradingClient/Database.hs:(0,0)-(0,0): Splicing declarations 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 + instance SuppressUnusedWarnings (AttrNotInSym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) AttrNotInSym1KindInference) ()) + data AttrNotInSym1 (a0123456789876543210 :: Attribute) :: (~>) Schema Bool + where + AttrNotInSym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (AttrNotInSym1 a0123456789876543210) arg) (AttrNotInSym2 a0123456789876543210 arg) => + AttrNotInSym1 a0123456789876543210 a0123456789876543210 + type instance Apply (AttrNotInSym1 a0123456789876543210) a0123456789876543210 = AttrNotIn a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings AttrNotInSym0 where + suppressUnusedWarnings = snd (((,) AttrNotInSym0KindInference) ()) + data AttrNotInSym0 :: (~>) Attribute ((~>) Schema Bool) + 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 instance SuppressUnusedWarnings (AppendSym1 a0123456789876543210) where @@ -460,12 +460,12 @@ GradingClient/Database.hs:(0,0)-(0,0): Splicing declarations type family Occurs (a :: [AChar]) (a :: Schema) :: Bool where Occurs _ (Sch '[]) = FalseSym0 Occurs name (Sch ( '(:) (Attr name' _) attrs)) = Apply (Apply (||@#@$) (Apply (Apply (==@#@$) name) name')) (Apply (Apply OccursSym0 name) (Apply SchSym0 attrs)) - type family AttrNotIn (a :: Attribute) (a :: Schema) :: Bool where - AttrNotIn _ (Sch '[]) = TrueSym0 - AttrNotIn (Attr name u) (Sch ( '(:) (Attr name' _) t)) = Apply (Apply (&&@#@$) (Apply (Apply (/=@#@$) name) name')) (Apply (Apply AttrNotInSym0 (Apply (Apply AttrSym0 name) u)) (Apply SchSym0 t)) type family Disjoint (a :: Schema) (a :: Schema) :: Bool where Disjoint (Sch '[]) _ = TrueSym0 Disjoint (Sch ( '(:) h t)) s = Apply (Apply (&&@#@$) (Apply (Apply AttrNotInSym0 h) s)) (Apply (Apply DisjointSym0 (Apply SchSym0 t)) s) + type family AttrNotIn (a :: Attribute) (a :: Schema) :: Bool where + AttrNotIn _ (Sch '[]) = TrueSym0 + AttrNotIn (Attr name u) (Sch ( '(:) (Attr name' _) t)) = Apply (Apply (&&@#@$) (Apply (Apply (/=@#@$) name) name')) (Apply (Apply AttrNotInSym0 (Apply (Apply AttrSym0 name) u)) (Apply SchSym0 t)) type family Append (a :: Schema) (a :: Schema) :: Schema where Append (Sch s1) (Sch s2) = Apply SchSym0 (Apply (Apply (++@#@$) s1) s2) type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: U) (a :: Symbol) :: Symbol where @@ -612,12 +612,12 @@ GradingClient/Database.hs:(0,0)-(0,0): Splicing declarations sOccurs :: forall (t :: [AChar]) (t :: Schema). Sing t -> Sing t -> Sing (Apply (Apply OccursSym0 t) t :: Bool) - sAttrNotIn :: - forall (t :: Attribute) (t :: Schema). - Sing t -> Sing t -> Sing (Apply (Apply AttrNotInSym0 t) t :: Bool) sDisjoint :: forall (t :: Schema) (t :: Schema). Sing t -> Sing t -> Sing (Apply (Apply DisjointSym0 t) t :: Bool) + sAttrNotIn :: + forall (t :: Attribute) (t :: Schema). + Sing t -> Sing t -> Sing (Apply (Apply AttrNotInSym0 t) t :: Bool) sAppend :: forall (t :: Schema) (t :: Schema). Sing t -> Sing t -> Sing (Apply (Apply AppendSym0 t) t :: Schema) @@ -651,18 +651,6 @@ GradingClient/Database.hs:(0,0)-(0,0): Splicing declarations sName'))) ((applySing ((applySing ((singFun2 @OccursSym0) sOccurs)) sName)) ((applySing ((singFun1 @SchSym0) SSch)) sAttrs)) - sAttrNotIn _ (SSch SNil) = STrue - sAttrNotIn - (SAttr (sName :: Sing name) (sU :: Sing u)) - (SSch (SCons (SAttr (sName' :: Sing name') _) (sT :: Sing t))) - = (applySing - ((applySing ((singFun2 @(&&@#@$)) (%&&))) - ((applySing ((applySing ((singFun2 @(/=@#@$)) (%/=))) sName)) - sName'))) - ((applySing - ((applySing ((singFun2 @AttrNotInSym0) sAttrNotIn)) - ((applySing ((applySing ((singFun2 @AttrSym0) SAttr)) sName)) sU))) - ((applySing ((singFun1 @SchSym0) SSch)) sT)) sDisjoint (SSch SNil) _ = STrue sDisjoint (SSch (SCons (sH :: Sing h) (sT :: Sing t))) @@ -676,6 +664,18 @@ GradingClient/Database.hs:(0,0)-(0,0): Splicing declarations ((applySing ((singFun2 @DisjointSym0) sDisjoint)) ((applySing ((singFun1 @SchSym0) SSch)) sT))) sS) + sAttrNotIn _ (SSch SNil) = STrue + sAttrNotIn + (SAttr (sName :: Sing name) (sU :: Sing u)) + (SSch (SCons (SAttr (sName' :: Sing name') _) (sT :: Sing t))) + = (applySing + ((applySing ((singFun2 @(&&@#@$)) (%&&))) + ((applySing ((applySing ((singFun2 @(/=@#@$)) (%/=))) sName)) + sName'))) + ((applySing + ((applySing ((singFun2 @AttrNotInSym0) sAttrNotIn)) + ((applySing ((applySing ((singFun2 @AttrSym0) SAttr)) sName)) sU))) + ((applySing ((singFun1 @SchSym0) SSch)) sT)) sAppend (SSch (sS1 :: Sing s1)) (SSch (sS2 :: Sing s2)) = (applySing ((singFun1 @SchSym0) SSch)) ((applySing ((applySing ((singFun2 @(++@#@$)) (%++))) sS1)) sS2) @@ -689,6 +689,12 @@ GradingClient/Database.hs:(0,0)-(0,0): Splicing declarations instance SingI d => SingI (OccursSym1 (d :: [AChar]) :: (~>) Schema Bool) where sing = (singFun1 @(OccursSym1 (d :: [AChar]))) (sOccurs (sing @d)) + instance SingI (DisjointSym0 :: (~>) Schema ((~>) Schema Bool)) where + sing = (singFun2 @DisjointSym0) sDisjoint + instance SingI d => + SingI (DisjointSym1 (d :: Schema) :: (~>) Schema Bool) where + sing + = (singFun1 @(DisjointSym1 (d :: Schema))) (sDisjoint (sing @d)) instance SingI (AttrNotInSym0 :: (~>) Attribute ((~>) Schema Bool)) where sing = (singFun2 @AttrNotInSym0) sAttrNotIn instance SingI d => @@ -696,12 +702,6 @@ GradingClient/Database.hs:(0,0)-(0,0): Splicing declarations sing = (singFun1 @(AttrNotInSym1 (d :: Attribute))) (sAttrNotIn (sing @d)) - instance SingI (DisjointSym0 :: (~>) Schema ((~>) Schema Bool)) where - sing = (singFun2 @DisjointSym0) sDisjoint - instance SingI d => - SingI (DisjointSym1 (d :: Schema) :: (~>) Schema Bool) where - sing - = (singFun1 @(DisjointSym1 (d :: Schema))) (sDisjoint (sing @d)) instance SingI (AppendSym0 :: (~>) Schema ((~>) Schema Schema)) where sing = (singFun2 @AppendSym0) sAppend instance SingI d => diff --git a/tests/compile-and-dump/GradingClient/Main.ghc86.template b/tests/compile-and-dump/GradingClient/Main.ghc86.template index e462f9c8..bb32a3fa 100644 --- a/tests/compile-and-dump/GradingClient/Main.ghc86.template +++ b/tests/compile-and-dump/GradingClient/Main.ghc86.template @@ -31,13 +31,17 @@ GradingClient/Main.hs:(0,0)-(0,0): Splicing declarations (Attr yearName) NAT, (Attr gradeName) NAT, (Attr majorName) BOOL] names :: Schema names = Sch [(Attr firstName) STRING, (Attr lastName) STRING] + type NamesSym0 = Names + type GradingSchemaSym0 = GradingSchema type MajorNameSym0 = MajorName type GradeNameSym0 = GradeName type YearNameSym0 = YearName type FirstNameSym0 = FirstName type LastNameSym0 = LastName - type GradingSchemaSym0 = GradingSchema - type NamesSym0 = Names + type family Names :: Schema where + Names = Apply SchSym0 (Apply (Apply (:@#@$) (Apply (Apply AttrSym0 FirstNameSym0) STRINGSym0)) (Apply (Apply (:@#@$) (Apply (Apply AttrSym0 LastNameSym0) STRINGSym0)) '[])) + type family GradingSchema :: Schema where + GradingSchema = Apply SchSym0 (Apply (Apply (:@#@$) (Apply (Apply AttrSym0 LastNameSym0) STRINGSym0)) (Apply (Apply (:@#@$) (Apply (Apply AttrSym0 FirstNameSym0) STRINGSym0)) (Apply (Apply (:@#@$) (Apply (Apply AttrSym0 YearNameSym0) NATSym0)) (Apply (Apply (:@#@$) (Apply (Apply AttrSym0 GradeNameSym0) NATSym0)) (Apply (Apply (:@#@$) (Apply (Apply AttrSym0 MajorNameSym0) BOOLSym0)) '[]))))) type family MajorName :: [AChar] where MajorName = Apply (Apply (:@#@$) CMSym0) (Apply (Apply (:@#@$) CASym0) (Apply (Apply (:@#@$) CJSym0) (Apply (Apply (:@#@$) COSym0) (Apply (Apply (:@#@$) CRSym0) '[])))) type family GradeName :: [AChar] where @@ -48,17 +52,47 @@ GradingClient/Main.hs:(0,0)-(0,0): Splicing declarations FirstName = Apply (Apply (:@#@$) CFSym0) (Apply (Apply (:@#@$) CISym0) (Apply (Apply (:@#@$) CRSym0) (Apply (Apply (:@#@$) CSSym0) (Apply (Apply (:@#@$) CTSym0) '[])))) type family LastName :: [AChar] where LastName = Apply (Apply (:@#@$) CLSym0) (Apply (Apply (:@#@$) CASym0) (Apply (Apply (:@#@$) CSSym0) (Apply (Apply (:@#@$) CTSym0) '[]))) - type family GradingSchema :: Schema where - GradingSchema = Apply SchSym0 (Apply (Apply (:@#@$) (Apply (Apply AttrSym0 LastNameSym0) STRINGSym0)) (Apply (Apply (:@#@$) (Apply (Apply AttrSym0 FirstNameSym0) STRINGSym0)) (Apply (Apply (:@#@$) (Apply (Apply AttrSym0 YearNameSym0) NATSym0)) (Apply (Apply (:@#@$) (Apply (Apply AttrSym0 GradeNameSym0) NATSym0)) (Apply (Apply (:@#@$) (Apply (Apply AttrSym0 MajorNameSym0) BOOLSym0)) '[]))))) - type family Names :: Schema where - Names = Apply SchSym0 (Apply (Apply (:@#@$) (Apply (Apply AttrSym0 FirstNameSym0) STRINGSym0)) (Apply (Apply (:@#@$) (Apply (Apply AttrSym0 LastNameSym0) STRINGSym0)) '[])) + sNames :: Sing (NamesSym0 :: Schema) + sGradingSchema :: Sing (GradingSchemaSym0 :: Schema) sMajorName :: Sing (MajorNameSym0 :: [AChar]) sGradeName :: Sing (GradeNameSym0 :: [AChar]) sYearName :: Sing (YearNameSym0 :: [AChar]) sFirstName :: Sing (FirstNameSym0 :: [AChar]) sLastName :: Sing (LastNameSym0 :: [AChar]) - sGradingSchema :: Sing (GradingSchemaSym0 :: Schema) - sNames :: Sing (NamesSym0 :: Schema) + sNames + = (applySing ((singFun1 @SchSym0) SSch)) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing ((applySing ((singFun2 @AttrSym0) SAttr)) sFirstName)) + SSTRING))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing ((applySing ((singFun2 @AttrSym0) SAttr)) sLastName)) + SSTRING))) + SNil)) + sGradingSchema + = (applySing ((singFun1 @SchSym0) SSch)) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing ((applySing ((singFun2 @AttrSym0) SAttr)) sLastName)) + SSTRING))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing ((applySing ((singFun2 @AttrSym0) SAttr)) sFirstName)) + SSTRING))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing ((applySing ((singFun2 @AttrSym0) SAttr)) sYearName)) + SNAT))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing ((applySing ((singFun2 @AttrSym0) SAttr)) sGradeName)) + SNAT))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing ((applySing ((singFun2 @AttrSym0) SAttr)) sMajorName)) + SBOOL))) + SNil))))) sMajorName = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCM)) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCA)) @@ -87,37 +121,3 @@ GradingClient/Main.hs:(0,0)-(0,0): Splicing declarations ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCA)) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCS)) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCT)) SNil))) - sGradingSchema - = (applySing ((singFun1 @SchSym0) SSch)) - ((applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((applySing ((applySing ((singFun2 @AttrSym0) SAttr)) sLastName)) - SSTRING))) - ((applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((applySing ((applySing ((singFun2 @AttrSym0) SAttr)) sFirstName)) - SSTRING))) - ((applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((applySing ((applySing ((singFun2 @AttrSym0) SAttr)) sYearName)) - SNAT))) - ((applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((applySing ((applySing ((singFun2 @AttrSym0) SAttr)) sGradeName)) - SNAT))) - ((applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((applySing ((applySing ((singFun2 @AttrSym0) SAttr)) sMajorName)) - SBOOL))) - SNil))))) - sNames - = (applySing ((singFun1 @SchSym0) SSch)) - ((applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((applySing ((applySing ((singFun2 @AttrSym0) SAttr)) sFirstName)) - SSTRING))) - ((applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((applySing ((applySing ((singFun2 @AttrSym0) SAttr)) sLastName)) - SSTRING))) - SNil)) diff --git a/tests/compile-and-dump/InsertionSort/InsertionSortImp.ghc86.template b/tests/compile-and-dump/InsertionSort/InsertionSortImp.ghc86.template index 332ebe07..6c2b01fc 100644 --- a/tests/compile-and-dump/InsertionSort/InsertionSortImp.ghc86.template +++ b/tests/compile-and-dump/InsertionSort/InsertionSortImp.ghc86.template @@ -103,25 +103,17 @@ InsertionSort/InsertionSortImp.hs:(0,0)-(0,0): Splicing declarations 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 LeqSym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) = - Leq a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (LeqSym1 a0123456789876543210) where - suppressUnusedWarnings = snd (((,) LeqSym1KindInference) ()) - data LeqSym1 (a0123456789876543210 :: Nat) :: (~>) Nat Bool - where - LeqSym1KindInference :: forall a0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply (LeqSym1 a0123456789876543210) arg) (LeqSym2 a0123456789876543210 arg) => - LeqSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (LeqSym1 a0123456789876543210) a0123456789876543210 = Leq a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings LeqSym0 where - suppressUnusedWarnings = snd (((,) LeqSym0KindInference) ()) - data LeqSym0 :: (~>) Nat ((~>) Nat Bool) + type InsertionSortSym1 (a0123456789876543210 :: [Nat]) = + InsertionSort a0123456789876543210 + instance SuppressUnusedWarnings InsertionSortSym0 where + suppressUnusedWarnings + = snd (((,) InsertionSortSym0KindInference) ()) + data InsertionSortSym0 :: (~>) [Nat] [Nat] where - LeqSym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply LeqSym0 arg) (LeqSym1 arg) => - LeqSym0 a0123456789876543210 - type instance Apply LeqSym0 a0123456789876543210 = LeqSym1 a0123456789876543210 + InsertionSortSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply InsertionSortSym0 arg) (InsertionSortSym1 arg) => + InsertionSortSym0 a0123456789876543210 + type instance Apply InsertionSortSym0 a0123456789876543210 = InsertionSort a0123456789876543210 type InsertSym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: [Nat]) = Insert a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (InsertSym1 a0123456789876543210) where @@ -141,40 +133,48 @@ InsertionSort/InsertionSortImp.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply InsertSym0 arg) (InsertSym1 arg) => InsertSym0 a0123456789876543210 type instance Apply InsertSym0 a0123456789876543210 = InsertSym1 a0123456789876543210 - type InsertionSortSym1 (a0123456789876543210 :: [Nat]) = - InsertionSort a0123456789876543210 - instance SuppressUnusedWarnings InsertionSortSym0 where - suppressUnusedWarnings - = snd (((,) InsertionSortSym0KindInference) ()) - data InsertionSortSym0 :: (~>) [Nat] [Nat] + type LeqSym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) = + Leq a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings (LeqSym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) LeqSym1KindInference) ()) + data LeqSym1 (a0123456789876543210 :: Nat) :: (~>) Nat Bool where - InsertionSortSym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply InsertionSortSym0 arg) (InsertionSortSym1 arg) => - InsertionSortSym0 a0123456789876543210 - type instance Apply InsertionSortSym0 a0123456789876543210 = InsertionSort a0123456789876543210 + LeqSym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (LeqSym1 a0123456789876543210) arg) (LeqSym2 a0123456789876543210 arg) => + LeqSym1 a0123456789876543210 a0123456789876543210 + type instance Apply (LeqSym1 a0123456789876543210) a0123456789876543210 = Leq 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 family InsertionSort (a :: [Nat]) :: [Nat] where + InsertionSort '[] = '[] + InsertionSort ( '(:) h t) = Apply (Apply InsertSym0 h) (Apply InsertionSortSym0 t) + type family Insert (a :: Nat) (a :: [Nat]) :: [Nat] where + Insert n '[] = Apply (Apply (:@#@$) n) '[] + Insert n ( '(:) h t) = Case_0123456789876543210 n h t (Let0123456789876543210Scrutinee_0123456789876543210Sym3 n h t) type family Leq (a :: Nat) (a :: Nat) :: Bool where Leq 'Zero _ = TrueSym0 Leq ( 'Succ _) 'Zero = FalseSym0 Leq ( 'Succ a) ( 'Succ b) = Apply (Apply LeqSym0 a) b - type family Insert (a :: Nat) (a :: [Nat]) :: [Nat] where - Insert n '[] = Apply (Apply (:@#@$) n) '[] - Insert n ( '(:) h t) = Case_0123456789876543210 n h t (Let0123456789876543210Scrutinee_0123456789876543210Sym3 n h t) - type family InsertionSort (a :: [Nat]) :: [Nat] where - InsertionSort '[] = '[] - InsertionSort ( '(:) h t) = Apply (Apply InsertSym0 h) (Apply InsertionSortSym0 t) - sLeq :: - forall (t :: Nat) (t :: Nat). - Sing t -> Sing t -> Sing (Apply (Apply LeqSym0 t) t :: Bool) - sInsert :: - forall (t :: Nat) (t :: [Nat]). - Sing t -> Sing t -> Sing (Apply (Apply InsertSym0 t) t :: [Nat]) sInsertionSort :: forall (t :: [Nat]). Sing t -> Sing (Apply InsertionSortSym0 t :: [Nat]) - sLeq SZero _ = STrue - sLeq (SSucc _) SZero = SFalse - sLeq (SSucc (sA :: Sing a)) (SSucc (sB :: Sing b)) - = (applySing ((applySing ((singFun2 @LeqSym0) sLeq)) sA)) sB + sInsert :: + forall (t :: Nat) (t :: [Nat]). + Sing t -> Sing t -> Sing (Apply (Apply InsertSym0 t) t :: [Nat]) + sLeq :: + forall (t :: Nat) (t :: Nat). + Sing t -> Sing t -> Sing (Apply (Apply LeqSym0 t) t :: Bool) + sInsertionSort SNil = SNil + sInsertionSort (SCons (sH :: Sing h) (sT :: Sing t)) + = (applySing ((applySing ((singFun2 @InsertSym0) sInsert)) sH)) + ((applySing ((singFun1 @InsertionSortSym0) sInsertionSort)) sT) sInsert (sN :: Sing n) SNil = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) sN)) SNil sInsert (sN :: Sing n) (SCons (sH :: Sing h) (sT :: Sing t)) @@ -193,19 +193,19 @@ InsertionSort/InsertionSortImp.hs:(0,0)-(0,0): Splicing declarations SFalse -> (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) sH)) ((applySing ((applySing ((singFun2 @InsertSym0) sInsert)) sN)) sT)) - sInsertionSort SNil = SNil - sInsertionSort (SCons (sH :: Sing h) (sT :: Sing t)) - = (applySing ((applySing ((singFun2 @InsertSym0) sInsert)) sH)) - ((applySing ((singFun1 @InsertionSortSym0) sInsertionSort)) sT) - instance SingI (LeqSym0 :: (~>) Nat ((~>) Nat Bool)) where - sing = (singFun2 @LeqSym0) sLeq - instance SingI d => - SingI (LeqSym1 (d :: Nat) :: (~>) Nat Bool) where - sing = (singFun1 @(LeqSym1 (d :: Nat))) (sLeq (sing @d)) + sLeq SZero _ = STrue + sLeq (SSucc _) SZero = SFalse + sLeq (SSucc (sA :: Sing a)) (SSucc (sB :: Sing b)) + = (applySing ((applySing ((singFun2 @LeqSym0) sLeq)) sA)) sB + instance SingI (InsertionSortSym0 :: (~>) [Nat] [Nat]) where + sing = (singFun1 @InsertionSortSym0) sInsertionSort instance SingI (InsertSym0 :: (~>) Nat ((~>) [Nat] [Nat])) where sing = (singFun2 @InsertSym0) sInsert instance SingI d => SingI (InsertSym1 (d :: Nat) :: (~>) [Nat] [Nat]) where sing = (singFun1 @(InsertSym1 (d :: Nat))) (sInsert (sing @d)) - instance SingI (InsertionSortSym0 :: (~>) [Nat] [Nat]) where - sing = (singFun1 @InsertionSortSym0) sInsertionSort + instance SingI (LeqSym0 :: (~>) Nat ((~>) Nat Bool)) where + sing = (singFun2 @LeqSym0) sLeq + instance SingI d => + SingI (LeqSym1 (d :: Nat) :: (~>) Nat Bool) where + sing = (singFun1 @(LeqSym1 (d :: Nat))) (sLeq (sing @d)) diff --git a/tests/compile-and-dump/Singletons/CaseExpressions.ghc86.template b/tests/compile-and-dump/Singletons/CaseExpressions.ghc86.template index 927fa3f3..1f0a313c 100644 --- a/tests/compile-and-dump/Singletons/CaseExpressions.ghc86.template +++ b/tests/compile-and-dump/Singletons/CaseExpressions.ghc86.template @@ -37,69 +37,69 @@ Singletons/CaseExpressions.hs:(0,0)-(0,0): Splicing declarations in z } foo5 :: a -> a foo5 x = case x of { y -> (\ _ -> x) y } - type family Case_0123456789876543210 x y arg_0123456789876543210 t where - Case_0123456789876543210 x y arg_0123456789876543210 _ = x - type family Lambda_0123456789876543210 x y t where - Lambda_0123456789876543210 x y arg_0123456789876543210 = Case_0123456789876543210 x y arg_0123456789876543210 arg_0123456789876543210 - type Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 t0123456789876543210 = - Lambda_0123456789876543210 x0123456789876543210 y0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) where + type family Case_0123456789876543210 arg_0123456789876543210 y x t where + 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 suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) - data Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 t0123456789876543210 + data Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210 t0123456789876543210 where - Lambda_0123456789876543210Sym2KindInference :: forall x0123456789876543210 - y0123456789876543210 + Lambda_0123456789876543210Sym2KindInference :: forall y0123456789876543210 + x0123456789876543210 t0123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210) arg) (Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 arg) => - Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 t0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 y0123456789876543210 x0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where + 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_0123456789876543210 x0123456789876543210 y0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 y0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) - data Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 + data Lambda_0123456789876543210Sym1 y0123456789876543210 x0123456789876543210 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 + Lambda_0123456789876543210Sym1KindInference :: forall y0123456789876543210 + x0123456789876543210 + 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 suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) - data Lambda_0123456789876543210Sym0 x0123456789876543210 + data Lambda_0123456789876543210Sym0 y0123456789876543210 where - Lambda_0123456789876543210Sym0KindInference :: forall x0123456789876543210 + Lambda_0123456789876543210Sym0KindInference :: forall y0123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 x0123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210 + Lambda_0123456789876543210Sym0 y0123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 y0123456789876543210 = Lambda_0123456789876543210Sym1 y0123456789876543210 type family Case_0123456789876543210 x t where - Case_0123456789876543210 x y = Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) y - type Let0123456789876543210ZSym2 x0123456789876543210 y0123456789876543210 = - Let0123456789876543210Z x0123456789876543210 y0123456789876543210 - instance SuppressUnusedWarnings (Let0123456789876543210ZSym1 x0123456789876543210) where + Case_0123456789876543210 x y = Apply (Apply (Apply Lambda_0123456789876543210Sym0 y) x) y + type Let0123456789876543210ZSym2 y0123456789876543210 x0123456789876543210 = + Let0123456789876543210Z y0123456789876543210 x0123456789876543210 + instance SuppressUnusedWarnings (Let0123456789876543210ZSym1 y0123456789876543210) where suppressUnusedWarnings = snd (((,) Let0123456789876543210ZSym1KindInference) ()) - data Let0123456789876543210ZSym1 x0123456789876543210 y0123456789876543210 + data Let0123456789876543210ZSym1 y0123456789876543210 x0123456789876543210 where - Let0123456789876543210ZSym1KindInference :: forall x0123456789876543210 - y0123456789876543210 - arg. SameKind (Apply (Let0123456789876543210ZSym1 x0123456789876543210) arg) (Let0123456789876543210ZSym2 x0123456789876543210 arg) => - Let0123456789876543210ZSym1 x0123456789876543210 y0123456789876543210 - type instance Apply (Let0123456789876543210ZSym1 x0123456789876543210) y0123456789876543210 = Let0123456789876543210Z x0123456789876543210 y0123456789876543210 + Let0123456789876543210ZSym1KindInference :: forall y0123456789876543210 + x0123456789876543210 + arg. SameKind (Apply (Let0123456789876543210ZSym1 y0123456789876543210) arg) (Let0123456789876543210ZSym2 y0123456789876543210 arg) => + Let0123456789876543210ZSym1 y0123456789876543210 x0123456789876543210 + type instance Apply (Let0123456789876543210ZSym1 y0123456789876543210) x0123456789876543210 = Let0123456789876543210Z y0123456789876543210 x0123456789876543210 instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where suppressUnusedWarnings = snd (((,) Let0123456789876543210ZSym0KindInference) ()) - data Let0123456789876543210ZSym0 x0123456789876543210 + data Let0123456789876543210ZSym0 y0123456789876543210 where - Let0123456789876543210ZSym0KindInference :: forall x0123456789876543210 + Let0123456789876543210ZSym0KindInference :: forall y0123456789876543210 arg. SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) => - Let0123456789876543210ZSym0 x0123456789876543210 - type instance Apply Let0123456789876543210ZSym0 x0123456789876543210 = Let0123456789876543210ZSym1 x0123456789876543210 - type family Let0123456789876543210Z x y :: a where - Let0123456789876543210Z x y = y + Let0123456789876543210ZSym0 y0123456789876543210 + type instance Apply Let0123456789876543210ZSym0 y0123456789876543210 = Let0123456789876543210ZSym1 y0123456789876543210 + type family Let0123456789876543210Z y x :: a where + Let0123456789876543210Z y x = y type family Case_0123456789876543210 x t where - Case_0123456789876543210 x y = Let0123456789876543210ZSym2 x y + Case_0123456789876543210 x y = Let0123456789876543210ZSym2 y x type Let0123456789876543210Scrutinee_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210 a0123456789876543210 b0123456789876543210 instance SuppressUnusedWarnings (Let0123456789876543210Scrutinee_0123456789876543210Sym1 a0123456789876543210) where @@ -261,12 +261,12 @@ Singletons/CaseExpressions.hs:(0,0)-(0,0): Splicing declarations (case sX of { (sY :: Sing y) -> (applySing - ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 x) y)) + ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 y) x)) (\ sArg_0123456789876543210 -> case sArg_0123456789876543210 of { (_ :: Sing arg_0123456789876543210) -> (id - @(Sing (Case_0123456789876543210 x y arg_0123456789876543210 arg_0123456789876543210))) + @(Sing (Case_0123456789876543210 arg_0123456789876543210 y x arg_0123456789876543210))) (case sArg_0123456789876543210 of { _ -> sX }) }))) sY }) sFoo4 (sX :: Sing x) @@ -274,7 +274,7 @@ Singletons/CaseExpressions.hs:(0,0)-(0,0): Splicing declarations (case sX of { (sY :: Sing y) -> let - sZ :: Sing (Let0123456789876543210ZSym2 x y :: a) + sZ :: Sing (Let0123456789876543210ZSym2 y x :: a) sZ = sY in sZ }) sFoo3 (sA :: Sing a) (sB :: Sing b) diff --git a/tests/compile-and-dump/Singletons/FunctorLikeDeriving.ghc86.template b/tests/compile-and-dump/Singletons/FunctorLikeDeriving.ghc86.template index 411e5b2b..c2b386c1 100644 --- a/tests/compile-and-dump/Singletons/FunctorLikeDeriving.ghc86.template +++ b/tests/compile-and-dump/Singletons/FunctorLikeDeriving.ghc86.template @@ -44,7 +44,7 @@ Singletons/FunctorLikeDeriving.hs:(0,0)-(0,0): Splicing declarations type instance Apply (MkT1Sym1 t0123456789876543210) t0123456789876543210 = MkT1Sym2 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings MkT1Sym0 where suppressUnusedWarnings = snd (((,) MkT1Sym0KindInference) ()) - data MkT1Sym0 :: forall a0123456789876543210 x0123456789876543210. + data MkT1Sym0 :: forall x0123456789876543210 a0123456789876543210. (~>) x0123456789876543210 ((~>) a0123456789876543210 ((~>) (Maybe a0123456789876543210) ((~>) (Maybe (Maybe a0123456789876543210)) (T x0123456789876543210 a0123456789876543210)))) where MkT1Sym0KindInference :: forall t0123456789876543210 @@ -55,7 +55,7 @@ Singletons/FunctorLikeDeriving.hs:(0,0)-(0,0): Splicing declarations MkT2 t0123456789876543210 instance SuppressUnusedWarnings MkT2Sym0 where suppressUnusedWarnings = snd (((,) MkT2Sym0KindInference) ()) - data MkT2Sym0 :: forall a0123456789876543210 x0123456789876543210. + data MkT2Sym0 :: forall x0123456789876543210 a0123456789876543210. (~>) (Maybe x0123456789876543210) (T x0123456789876543210 a0123456789876543210) where MkT2Sym0KindInference :: forall t0123456789876543210 @@ -385,8 +385,8 @@ Singletons/FunctorLikeDeriving.hs:(0,0)-(0,0): Splicing declarations instance SuppressUnusedWarnings (TFHelper_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) TFHelper_0123456789876543210Sym1KindInference) ()) - data TFHelper_0123456789876543210Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210 - x0123456789876543210. + data TFHelper_0123456789876543210Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall x0123456789876543210 + b0123456789876543210. (~>) (T x0123456789876543210 b0123456789876543210) (T x0123456789876543210 a0123456789876543210) where TFHelper_0123456789876543210Sym1KindInference :: forall a0123456789876543210 @@ -398,8 +398,8 @@ Singletons/FunctorLikeDeriving.hs:(0,0)-(0,0): Splicing declarations suppressUnusedWarnings = snd (((,) TFHelper_0123456789876543210Sym0KindInference) ()) data TFHelper_0123456789876543210Sym0 :: forall a0123456789876543210 - b0123456789876543210 - x0123456789876543210. + x0123456789876543210 + b0123456789876543210. (~>) a0123456789876543210 ((~>) (T x0123456789876543210 b0123456789876543210) (T x0123456789876543210 a0123456789876543210)) where TFHelper_0123456789876543210Sym0KindInference :: forall a0123456789876543210 @@ -752,147 +752,147 @@ 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 _z_0123456789876543210 n1_0123456789876543210 n2_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 t t where - Lambda_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 n1_0123456789876543210 n2_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 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 = - Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym9 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + 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 suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym9KindInference) ()) - data Lambda_0123456789876543210Sym9 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 + data Lambda_0123456789876543210Sym9 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 where - Lambda_0123456789876543210Sym9KindInference :: forall _f_01234567898765432100123456789876543210 - _z_01234567898765432100123456789876543210 - n1_01234567898765432100123456789876543210 + Lambda_0123456789876543210Sym9KindInference :: forall n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 + _f_01234567898765432100123456789876543210 + _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym9 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210) arg) (Lambda_0123456789876543210Sym10 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 arg) => - Lambda_0123456789876543210Sym9 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_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 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym8 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + 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_0123456789876543210 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 suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym8KindInference) ()) - data Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + data Lambda_0123456789876543210Sym8 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 where - Lambda_0123456789876543210Sym8KindInference :: forall _f_01234567898765432100123456789876543210 - _z_01234567898765432100123456789876543210 - n1_01234567898765432100123456789876543210 + Lambda_0123456789876543210Sym8KindInference :: forall n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 + _f_01234567898765432100123456789876543210 + _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym9 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym8 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym9 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym7 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + 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 suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym7KindInference) ()) - data Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + data Lambda_0123456789876543210Sym7 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym7KindInference :: forall _f_01234567898765432100123456789876543210 - _z_01234567898765432100123456789876543210 - n1_01234567898765432100123456789876543210 + Lambda_0123456789876543210Sym7KindInference :: forall n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 + _f_01234567898765432100123456789876543210 + _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym7 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym8 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym6 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + 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 suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym6KindInference) ()) - data Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + data Lambda_0123456789876543210Sym6 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym6KindInference :: forall _f_01234567898765432100123456789876543210 - _z_01234567898765432100123456789876543210 - n1_01234567898765432100123456789876543210 + Lambda_0123456789876543210Sym6KindInference :: forall n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 + _f_01234567898765432100123456789876543210 + _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym6 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym7 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + 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 suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym5KindInference) ()) - data Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + data Lambda_0123456789876543210Sym5 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym5KindInference :: forall _f_01234567898765432100123456789876543210 - _z_01234567898765432100123456789876543210 - n1_01234567898765432100123456789876543210 + Lambda_0123456789876543210Sym5KindInference :: forall n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 + _f_01234567898765432100123456789876543210 + _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym6 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_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 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 suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym4KindInference) ()) - data Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 + data Lambda_0123456789876543210Sym4 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym4KindInference :: forall _f_01234567898765432100123456789876543210 - _z_01234567898765432100123456789876543210 - n1_01234567898765432100123456789876543210 + Lambda_0123456789876543210Sym4KindInference :: forall n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 + _f_01234567898765432100123456789876543210 + _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym4 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym5 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_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 _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 suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) - data Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 + data Lambda_0123456789876543210Sym3 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym3KindInference :: forall _f_01234567898765432100123456789876543210 - _z_01234567898765432100123456789876543210 - n1_01234567898765432100123456789876543210 + Lambda_0123456789876543210Sym3KindInference :: forall n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym3 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) n2_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym4 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where + _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 suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) - data Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 + data Lambda_0123456789876543210Sym2 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym2KindInference :: forall _f_01234567898765432100123456789876543210 - _z_01234567898765432100123456789876543210 - n1_01234567898765432100123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) n1_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 _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 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 + 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 suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) - data Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 + data Lambda_0123456789876543210Sym0 n1_01234567898765432100123456789876543210 where - Lambda_0123456789876543210Sym0KindInference :: forall _f_01234567898765432100123456789876543210 + Lambda_0123456789876543210Sym0KindInference :: forall n1_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_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 _f_0123456789876543210) _z_0123456789876543210) n1_0123456789876543210) n2_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210)) n2_0123456789876543210) n1_0123456789876543210 + 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 @@ -1117,8 +1117,8 @@ Singletons/FunctorLikeDeriving.hs:(0,0)-(0,0): Splicing declarations suppressUnusedWarnings = snd (((,) Traverse_0123456789876543210Sym0KindInference) ()) data Traverse_0123456789876543210Sym0 :: forall a0123456789876543210 - b0123456789876543210 f0123456789876543210 + b0123456789876543210 x0123456789876543210. (~>) ((~>) a0123456789876543210 (f0123456789876543210 b0123456789876543210)) ((~>) (T x0123456789876543210 a0123456789876543210) (f0123456789876543210 (T x0123456789876543210 b0123456789876543210))) where @@ -1230,8 +1230,8 @@ Singletons/FunctorLikeDeriving.hs:(0,0)-(0,0): Splicing declarations suppressUnusedWarnings = snd (((,) Traverse_0123456789876543210Sym0KindInference) ()) data Traverse_0123456789876543210Sym0 :: forall a0123456789876543210 - b0123456789876543210 - f0123456789876543210. + f0123456789876543210 + b0123456789876543210. (~>) ((~>) a0123456789876543210 (f0123456789876543210 b0123456789876543210)) ((~>) (Empty a0123456789876543210) (f0123456789876543210 (Empty b0123456789876543210))) where Traverse_0123456789876543210Sym0KindInference :: forall a0123456789876543210 @@ -1378,7 +1378,7 @@ Singletons/FunctorLikeDeriving.hs:(0,0)-(0,0): Splicing declarations sA_0123456789876543210) instance SFoldable (T x) where sFoldMap :: - forall (m :: Type) (a :: Type) (t1 :: (~>) a m) (t2 :: T x a). + forall (a :: Type) (m :: Type) (t1 :: (~>) a m) (t2 :: T x a). SMonoid m => Sing t1 -> Sing t2 @@ -1480,7 +1480,7 @@ Singletons/FunctorLikeDeriving.hs:(0,0)-(0,0): Splicing declarations ((applySing ((applySing ((singFun3 @FoldrSym0) sFoldr)) ((singFun2 - @(Apply (Apply (Apply (Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) _z_0123456789876543210) n1_0123456789876543210) n2_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210)) + @(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)) (\ sN1_0123456789876543210 sN2_0123456789876543210 -> case @@ -1519,8 +1519,8 @@ Singletons/FunctorLikeDeriving.hs:(0,0)-(0,0): Splicing declarations _sz_0123456789876543210 instance STraversable (T x) where sTraverse :: - forall (f :: Type -> Type) - (a :: Type) + forall (a :: Type) + (f :: Type -> Type) (b :: Type) (t1 :: (~>) a (f b)) (t2 :: T x a). @@ -1584,7 +1584,7 @@ Singletons/FunctorLikeDeriving.hs:(0,0)-(0,0): Splicing declarations (case sV_0123456789876543210 of) instance SFoldable Empty where sFoldMap :: - forall (m :: Type) (a :: Type) (t1 :: (~>) a m) (t2 :: Empty a). + forall (a :: Type) (m :: Type) (t1 :: (~>) a m) (t2 :: Empty a). SMonoid m => Sing t1 -> Sing t2 @@ -1593,8 +1593,8 @@ Singletons/FunctorLikeDeriving.hs:(0,0)-(0,0): Splicing declarations sFoldMap _ _ = sMempty instance STraversable Empty where sTraverse :: - forall (f :: Type -> Type) - (a :: Type) + forall (a :: Type) + (f :: Type -> Type) (b :: Type) (t1 :: (~>) a (f b)) (t2 :: Empty a). diff --git a/tests/compile-and-dump/Singletons/HigherOrder.ghc86.template b/tests/compile-and-dump/Singletons/HigherOrder.ghc86.template index c9dfc032..c6cab35f 100644 --- a/tests/compile-and-dump/Singletons/HigherOrder.ghc86.template +++ b/tests/compile-and-dump/Singletons/HigherOrder.ghc86.template @@ -55,62 +55,13 @@ Singletons/HigherOrder.hs:(0,0)-(0,0): Splicing declarations Right t0123456789876543210 instance SuppressUnusedWarnings RightSym0 where suppressUnusedWarnings = snd (((,) RightSym0KindInference) ()) - data RightSym0 :: forall a0123456789876543210 b0123456789876543210. + data RightSym0 :: forall b0123456789876543210 a0123456789876543210. (~>) b0123456789876543210 (Either a0123456789876543210 b0123456789876543210) where RightSym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply RightSym0 arg) (RightSym1 arg) => RightSym0 t0123456789876543210 type instance Apply RightSym0 t0123456789876543210 = Right t0123456789876543210 - type family Case_0123456789876543210 ns bs n b t where - Case_0123456789876543210 ns bs n b 'True = Apply SuccSym0 (Apply SuccSym0 n) - Case_0123456789876543210 ns bs n b 'False = n - type family Lambda_0123456789876543210 ns bs t t where - Lambda_0123456789876543210 ns bs n b = Case_0123456789876543210 ns bs n b b - type Lambda_0123456789876543210Sym4 ns0123456789876543210 bs0123456789876543210 t0123456789876543210 t0123456789876543210 = - Lambda_0123456789876543210 ns0123456789876543210 bs0123456789876543210 t0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 t0123456789876543210 bs0123456789876543210 ns0123456789876543210) where - suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) - data Lambda_0123456789876543210Sym3 ns0123456789876543210 bs0123456789876543210 t0123456789876543210 t0123456789876543210 - where - Lambda_0123456789876543210Sym3KindInference :: 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_0123456789876543210 t0123456789876543210 bs0123456789876543210 ns0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 bs0123456789876543210 ns0123456789876543210) where - suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) - data Lambda_0123456789876543210Sym2 ns0123456789876543210 bs0123456789876543210 t0123456789876543210 - where - Lambda_0123456789876543210Sym2KindInference :: forall ns0123456789876543210 - bs0123456789876543210 - 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 - suppressUnusedWarnings - = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) - data Lambda_0123456789876543210Sym1 ns0123456789876543210 bs0123456789876543210 - where - Lambda_0123456789876543210Sym1KindInference :: 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 - 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 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 @@ -160,6 +111,93 @@ Singletons/HigherOrder.hs:(0,0)-(0,0): Splicing declarations 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 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 + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) + data Lambda_0123456789876543210Sym3 ns0123456789876543210 bs0123456789876543210 t0123456789876543210 t0123456789876543210 + where + Lambda_0123456789876543210Sym3KindInference :: 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_0123456789876543210 t0123456789876543210 bs0123456789876543210 ns0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 bs0123456789876543210 ns0123456789876543210) where + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) + data Lambda_0123456789876543210Sym2 ns0123456789876543210 bs0123456789876543210 t0123456789876543210 + where + Lambda_0123456789876543210Sym2KindInference :: forall ns0123456789876543210 + bs0123456789876543210 + 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 + suppressUnusedWarnings + = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) + data Lambda_0123456789876543210Sym1 ns0123456789876543210 bs0123456789876543210 + where + Lambda_0123456789876543210Sym1KindInference :: 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 + 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 + instance SuppressUnusedWarnings (EtadSym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) EtadSym1KindInference) ()) + data EtadSym1 (a0123456789876543210 :: [Nat]) :: (~>) [Bool] [Nat] + where + EtadSym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (EtadSym1 a0123456789876543210) arg) (EtadSym2 a0123456789876543210 arg) => + EtadSym1 a0123456789876543210 a0123456789876543210 + type instance Apply (EtadSym1 a0123456789876543210) a0123456789876543210 = Etad a0123456789876543210 a0123456789876543210 + instance SuppressUnusedWarnings EtadSym0 where + suppressUnusedWarnings = snd (((,) EtadSym0KindInference) ()) + data EtadSym0 :: (~>) [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 + instance SuppressUnusedWarnings (SplungeSym1 a0123456789876543210) where + suppressUnusedWarnings = snd (((,) SplungeSym1KindInference) ()) + data SplungeSym1 (a0123456789876543210 :: [Nat]) :: (~>) [Bool] [Nat] + where + SplungeSym1KindInference :: forall a0123456789876543210 + a0123456789876543210 + arg. SameKind (Apply (SplungeSym1 a0123456789876543210) arg) (SplungeSym2 a0123456789876543210 arg) => + SplungeSym1 a0123456789876543210 a0123456789876543210 + type instance Apply (SplungeSym1 a0123456789876543210) a0123456789876543210 = Splunge 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 @@ -222,44 +260,6 @@ 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 SplungeSym2 (a0123456789876543210 :: [Nat]) (a0123456789876543210 :: [Bool]) = - Splunge a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (SplungeSym1 a0123456789876543210) where - suppressUnusedWarnings = snd (((,) SplungeSym1KindInference) ()) - data SplungeSym1 (a0123456789876543210 :: [Nat]) :: (~>) [Bool] [Nat] - where - SplungeSym1KindInference :: forall a0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply (SplungeSym1 a0123456789876543210) arg) (SplungeSym2 a0123456789876543210 arg) => - SplungeSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (SplungeSym1 a0123456789876543210) a0123456789876543210 = Splunge 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 EtadSym2 (a0123456789876543210 :: [Nat]) (a0123456789876543210 :: [Bool]) = - Etad a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (EtadSym1 a0123456789876543210) where - suppressUnusedWarnings = snd (((,) EtadSym1KindInference) ()) - data EtadSym1 (a0123456789876543210 :: [Nat]) :: (~>) [Bool] [Nat] - where - EtadSym1KindInference :: forall a0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply (EtadSym1 a0123456789876543210) arg) (EtadSym2 a0123456789876543210 arg) => - EtadSym1 a0123456789876543210 a0123456789876543210 - type instance Apply (EtadSym1 a0123456789876543210) a0123456789876543210 = Etad a0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings EtadSym0 where - suppressUnusedWarnings = snd (((,) EtadSym0KindInference) ()) - data EtadSym0 :: (~>) [Nat] ((~>) [Bool] [Nat]) - where - EtadSym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply EtadSym0 arg) (EtadSym1 arg) => - EtadSym0 a0123456789876543210 - type instance Apply EtadSym0 a0123456789876543210 = EtadSym1 a0123456789876543210 type LiftMaybeSym2 (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) (a0123456789876543210 :: Maybe a0123456789876543210) = LiftMaybe a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (LiftMaybeSym1 a0123456789876543210) where @@ -301,6 +301,10 @@ 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 + 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 + Splunge ns bs = Apply (Apply (Apply ZipWithSym0 (Apply (Apply Lambda_0123456789876543210Sym0 ns) bs)) ns) bs type family Foo (a :: (~>) ((~>) a b) ((~>) a b)) (a :: (~>) a b) (a :: a) :: b where Foo f g a = Apply (Apply f g) a type family ZipWith (a :: (~>) a ((~>) b c)) (a :: [a]) (a :: [b]) :: [c] where @@ -308,16 +312,18 @@ Singletons/HigherOrder.hs:(0,0)-(0,0): Splicing declarations ZipWith _ '[] '[] = '[] ZipWith _ ( '(:) _ _) '[] = '[] ZipWith _ '[] ( '(:) _ _) = '[] - type family Splunge (a :: [Nat]) (a :: [Bool]) :: [Nat] where - Splunge ns bs = Apply (Apply (Apply ZipWithSym0 (Apply (Apply Lambda_0123456789876543210Sym0 ns) bs)) ns) bs - 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 LiftMaybe (a :: (~>) a b) (a :: Maybe a) :: Maybe b where LiftMaybe f ( 'Just x) = Apply JustSym0 (Apply f x) LiftMaybe _ 'Nothing = NothingSym0 type family Map (a :: (~>) a b) (a :: [a]) :: [b] where Map _ '[] = '[] Map f ( '(:) h t) = Apply (Apply (:@#@$) (Apply f h)) (Apply (Apply MapSym0 f) t) + sEtad :: + forall (t :: [Nat]) (t :: [Bool]). + Sing t -> Sing t -> Sing (Apply (Apply EtadSym0 t) t :: [Nat]) + sSplunge :: + forall (t :: [Nat]) (t :: [Bool]). + Sing t -> Sing t -> Sing (Apply (Apply SplungeSym0 t) t :: [Nat]) sFoo :: forall a b @@ -332,12 +338,6 @@ Singletons/HigherOrder.hs:(0,0)-(0,0): Splicing declarations Sing t -> Sing t -> Sing t -> Sing (Apply (Apply (Apply ZipWithSym0 t) t) t :: [c]) - sSplunge :: - forall (t :: [Nat]) (t :: [Bool]). - Sing t -> Sing t -> Sing (Apply (Apply SplungeSym0 t) t :: [Nat]) - sEtad :: - forall (t :: [Nat]) (t :: [Bool]). - Sing t -> Sing t -> Sing (Apply (Apply EtadSym0 t) t :: [Nat]) sLiftMaybe :: forall a b (t :: (~>) a b) (t :: Maybe a). Sing t @@ -345,58 +345,58 @@ Singletons/HigherOrder.hs:(0,0)-(0,0): Splicing declarations sMap :: forall a b (t :: (~>) a b) (t :: [a]). Sing t -> Sing t -> Sing (Apply (Apply MapSym0 t) t :: [b]) - sFoo (sF :: Sing f) (sG :: Sing g) (sA :: Sing a) - = (applySing ((applySing sF) sG)) sA - sZipWith - (sF :: Sing f) - (SCons (sX :: Sing x) (sXs :: Sing xs)) - (SCons (sY :: Sing y) (sYs :: Sing ys)) - = (applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((applySing ((applySing sF) sX)) sY))) - ((applySing - ((applySing ((applySing ((singFun3 @ZipWithSym0) sZipWith)) sF)) - sXs)) - sYs) - sZipWith _ SNil SNil = SNil - sZipWith _ (SCons _ _) SNil = SNil - sZipWith _ SNil (SCons _ _) = SNil - sSplunge (sNs :: Sing ns) (sBs :: Sing bs) + sEtad + (sA_0123456789876543210 :: Sing a_0123456789876543210) + (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((applySing ((singFun3 @ZipWithSym0) sZipWith)) - ((singFun2 @(Apply (Apply Lambda_0123456789876543210Sym0 ns) bs)) + ((singFun2 + @(Apply (Apply Lambda_0123456789876543210Sym0 a_0123456789876543210) a_0123456789876543210)) (\ sN sB -> case ((,) sN) sB of { (,) (_ :: Sing n) (_ :: Sing b) - -> (id @(Sing (Case_0123456789876543210 ns bs n b b))) + -> (id + @(Sing (Case_0123456789876543210 n b a_0123456789876543210 a_0123456789876543210 b))) (case sB of STrue -> (applySing ((singFun1 @SuccSym0) SSucc)) ((applySing ((singFun1 @SuccSym0) SSucc)) sN) SFalse -> sN) })))) - sNs)) - sBs - sEtad - (sA_0123456789876543210 :: Sing a_0123456789876543210) - (sA_0123456789876543210 :: Sing a_0123456789876543210) + sA_0123456789876543210)) + sA_0123456789876543210 + sSplunge (sNs :: Sing ns) (sBs :: Sing bs) = (applySing ((applySing ((applySing ((singFun3 @ZipWithSym0) sZipWith)) - ((singFun2 - @(Apply (Apply Lambda_0123456789876543210Sym0 a_0123456789876543210) a_0123456789876543210)) + ((singFun2 @(Apply (Apply Lambda_0123456789876543210Sym0 ns) bs)) (\ sN sB -> case ((,) sN) sB of { (,) (_ :: Sing n) (_ :: Sing b) - -> (id - @(Sing (Case_0123456789876543210 n b a_0123456789876543210 a_0123456789876543210 b))) + -> (id @(Sing (Case_0123456789876543210 n b ns bs b))) (case sB of STrue -> (applySing ((singFun1 @SuccSym0) SSucc)) ((applySing ((singFun1 @SuccSym0) SSucc)) sN) SFalse -> sN) })))) - sA_0123456789876543210)) - sA_0123456789876543210 + sNs)) + sBs + sFoo (sF :: Sing f) (sG :: Sing g) (sA :: Sing a) + = (applySing ((applySing sF) sG)) sA + sZipWith + (sF :: Sing f) + (SCons (sX :: Sing x) (sXs :: Sing xs)) + (SCons (sY :: Sing y) (sYs :: Sing ys)) + = (applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing ((applySing sF) sX)) sY))) + ((applySing + ((applySing ((applySing ((singFun3 @ZipWithSym0) sZipWith)) sF)) + sXs)) + sYs) + sZipWith _ SNil SNil = SNil + sZipWith _ (SCons _ _) SNil = SNil + sZipWith _ SNil (SCons _ _) = SNil sLiftMaybe (sF :: Sing f) (SJust (sX :: Sing x)) = (applySing ((singFun1 @JustSym0) SJust)) ((applySing sF) sX) sLiftMaybe _ SNothing = SNothing @@ -405,6 +405,16 @@ Singletons/HigherOrder.hs:(0,0)-(0,0): Splicing declarations = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing sF) sH))) ((applySing ((applySing ((singFun2 @MapSym0) sMap)) sF)) sT) + instance SingI (EtadSym0 :: (~>) [Nat] ((~>) [Bool] [Nat])) where + sing = (singFun2 @EtadSym0) sEtad + instance SingI d => + SingI (EtadSym1 (d :: [Nat]) :: (~>) [Bool] [Nat]) where + sing = (singFun1 @(EtadSym1 (d :: [Nat]))) (sEtad (sing @d)) + instance SingI (SplungeSym0 :: (~>) [Nat] ((~>) [Bool] [Nat])) where + sing = (singFun2 @SplungeSym0) sSplunge + instance SingI d => + SingI (SplungeSym1 (d :: [Nat]) :: (~>) [Bool] [Nat]) where + sing = (singFun1 @(SplungeSym1 (d :: [Nat]))) (sSplunge (sing @d)) instance SingI (FooSym0 :: (~>) ((~>) ((~>) a b) ((~>) a b)) ((~>) ((~>) a b) ((~>) a b))) where sing = (singFun3 @FooSym0) sFoo instance SingI d => @@ -430,16 +440,6 @@ Singletons/HigherOrder.hs:(0,0)-(0,0): Splicing declarations sing = (singFun1 @(ZipWithSym2 (d :: (~>) a ((~>) b c)) (d :: [a]))) ((sZipWith (sing @d)) (sing @d)) - instance SingI (SplungeSym0 :: (~>) [Nat] ((~>) [Bool] [Nat])) where - sing = (singFun2 @SplungeSym0) sSplunge - instance SingI d => - SingI (SplungeSym1 (d :: [Nat]) :: (~>) [Bool] [Nat]) where - sing = (singFun1 @(SplungeSym1 (d :: [Nat]))) (sSplunge (sing @d)) - instance SingI (EtadSym0 :: (~>) [Nat] ((~>) [Bool] [Nat])) where - sing = (singFun2 @EtadSym0) sEtad - instance SingI d => - SingI (EtadSym1 (d :: [Nat]) :: (~>) [Bool] [Nat]) where - sing = (singFun1 @(EtadSym1 (d :: [Nat]))) (sEtad (sing @d)) instance SingI (LiftMaybeSym0 :: (~>) ((~>) a b) ((~>) (Maybe a) (Maybe b))) where sing = (singFun2 @LiftMaybeSym0) sLiftMaybe instance SingI d => diff --git a/tests/compile-and-dump/Singletons/LambdaCase.ghc86.template b/tests/compile-and-dump/Singletons/LambdaCase.ghc86.template index 4f2b6908..6d4fce7c 100644 --- a/tests/compile-and-dump/Singletons/LambdaCase.ghc86.template +++ b/tests/compile-and-dump/Singletons/LambdaCase.ghc86.template @@ -29,10 +29,10 @@ Singletons/LambdaCase.hs:(0,0)-(0,0): Splicing declarations (Just d) foo3 :: a -> b -> a foo3 a b = (\case (p, _) -> p) (a, b) - type family Case_0123456789876543210 a b x_0123456789876543210 t where - Case_0123456789876543210 a b x_0123456789876543210 '(p, _) = p + type family Case_0123456789876543210 x_0123456789876543210 a b t where + Case_0123456789876543210 x_0123456789876543210 a b '(p, _) = p type family Lambda_0123456789876543210 a b t where - Lambda_0123456789876543210 a b x_0123456789876543210 = Case_0123456789876543210 a b x_0123456789876543210 x_0123456789876543210 + 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 @@ -65,11 +65,11 @@ Singletons/LambdaCase.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 a0123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 a0123456789876543210 = Lambda_0123456789876543210Sym1 a0123456789876543210 - type family Case_0123456789876543210 d x_0123456789876543210 t where - Case_0123456789876543210 d x_0123456789876543210 ( 'Just y) = y - Case_0123456789876543210 d x_0123456789876543210 'Nothing = d + 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 d x_0123456789876543210 x_0123456789876543210 + Lambda_0123456789876543210 d x_0123456789876543210 = Case_0123456789876543210 x_0123456789876543210 d x_0123456789876543210 type Lambda_0123456789876543210Sym2 d0123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 d0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 d0123456789876543210) where @@ -91,11 +91,11 @@ 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 d x x_0123456789876543210 t where - Case_0123456789876543210 d x x_0123456789876543210 ( 'Just y) = y - Case_0123456789876543210 d x x_0123456789876543210 'Nothing = d + 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 d x x_0123456789876543210 x_0123456789876543210 + 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 @@ -211,7 +211,7 @@ Singletons/LambdaCase.hs:(0,0)-(0,0): Splicing declarations -> case sX_0123456789876543210 of { (_ :: Sing x_0123456789876543210) -> (id - @(Sing (Case_0123456789876543210 a b x_0123456789876543210 x_0123456789876543210))) + @(Sing (Case_0123456789876543210 x_0123456789876543210 a b x_0123456789876543210))) (case sX_0123456789876543210 of { STuple2 (sP :: Sing p) _ -> sP }) }))) ((applySing ((applySing ((singFun2 @Tuple2Sym0) STuple2)) sA)) sB) @@ -222,7 +222,7 @@ Singletons/LambdaCase.hs:(0,0)-(0,0): Splicing declarations -> case sX_0123456789876543210 of { (_ :: Sing x_0123456789876543210) -> (id - @(Sing (Case_0123456789876543210 d x_0123456789876543210 x_0123456789876543210))) + @(Sing (Case_0123456789876543210 x_0123456789876543210 d x_0123456789876543210))) (case sX_0123456789876543210 of SJust (sY :: Sing y) -> sY SNothing -> sD) }))) @@ -234,7 +234,7 @@ Singletons/LambdaCase.hs:(0,0)-(0,0): Splicing declarations -> case sX_0123456789876543210 of { (_ :: Sing x_0123456789876543210) -> (id - @(Sing (Case_0123456789876543210 d x x_0123456789876543210 x_0123456789876543210))) + @(Sing (Case_0123456789876543210 x_0123456789876543210 d x x_0123456789876543210))) (case sX_0123456789876543210 of SJust (sY :: Sing y) -> sY SNothing -> sD) }))) diff --git a/tests/compile-and-dump/Singletons/Lambdas.ghc86.template b/tests/compile-and-dump/Singletons/Lambdas.ghc86.template index fb960126..0b1daf4e 100644 --- a/tests/compile-and-dump/Singletons/Lambdas.ghc86.template +++ b/tests/compile-and-dump/Singletons/Lambdas.ghc86.template @@ -61,10 +61,10 @@ Singletons/Lambdas.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) => FooSym0 t0123456789876543210 type instance Apply FooSym0 t0123456789876543210 = FooSym1 t0123456789876543210 - type family Case_0123456789876543210 x arg_0123456789876543210 t where - Case_0123456789876543210 x arg_0123456789876543210 (Foo a _) = a + type family 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 x arg_0123456789876543210 arg_0123456789876543210 + Lambda_0123456789876543210 x arg_0123456789876543210 = Case_0123456789876543210 arg_0123456789876543210 x arg_0123456789876543210 type Lambda_0123456789876543210Sym2 x0123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where @@ -86,10 +86,10 @@ 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 x y arg_0123456789876543210 t where - Case_0123456789876543210 x y arg_0123456789876543210 '(_, b) = b + 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 x y arg_0123456789876543210 arg_0123456789876543210 + 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 @@ -122,56 +122,56 @@ 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 a b x arg_0123456789876543210 t where - Case_0123456789876543210 a b x arg_0123456789876543210 _ = x - type family Lambda_0123456789876543210 a b x t where - Lambda_0123456789876543210 a b x arg_0123456789876543210 = Case_0123456789876543210 a b x arg_0123456789876543210 arg_0123456789876543210 - type Lambda_0123456789876543210Sym4 a0123456789876543210 b0123456789876543210 x0123456789876543210 t0123456789876543210 = - Lambda_0123456789876543210 a0123456789876543210 b0123456789876543210 x0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 x0123456789876543210 b0123456789876543210 a0123456789876543210) where + 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 suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) - data Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 x0123456789876543210 t0123456789876543210 + data Lambda_0123456789876543210Sym3 x0123456789876543210 a0123456789876543210 b0123456789876543210 t0123456789876543210 where - Lambda_0123456789876543210Sym3KindInference :: forall a0123456789876543210 + Lambda_0123456789876543210Sym3KindInference :: forall x0123456789876543210 + a0123456789876543210 b0123456789876543210 - x0123456789876543210 t0123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 x0123456789876543210) arg) (Lambda_0123456789876543210Sym4 a0123456789876543210 b0123456789876543210 x0123456789876543210 arg) => - Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 x0123456789876543210 t0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym3 x0123456789876543210 b0123456789876543210 a0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 b0123456789876543210 a0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 b0123456789876543210 a0123456789876543210) where + 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_0123456789876543210 b0123456789876543210 a0123456789876543210 x0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 a0123456789876543210 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) - data Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210 x0123456789876543210 + data Lambda_0123456789876543210Sym2 x0123456789876543210 a0123456789876543210 b0123456789876543210 where - Lambda_0123456789876543210Sym2KindInference :: forall a0123456789876543210 + Lambda_0123456789876543210Sym2KindInference :: forall x0123456789876543210 + a0123456789876543210 b0123456789876543210 - x0123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210) arg) (Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 arg) => - Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210 x0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 b0123456789876543210 a0123456789876543210) x0123456789876543210 = Lambda_0123456789876543210Sym3 b0123456789876543210 a0123456789876543210 x0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 a0123456789876543210) where + 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 suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) - data Lambda_0123456789876543210Sym1 a0123456789876543210 b0123456789876543210 + data Lambda_0123456789876543210Sym1 x0123456789876543210 a0123456789876543210 where - Lambda_0123456789876543210Sym1KindInference :: forall a0123456789876543210 - b0123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym1 a0123456789876543210) arg) (Lambda_0123456789876543210Sym2 a0123456789876543210 arg) => - Lambda_0123456789876543210Sym1 a0123456789876543210 b0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym1 a0123456789876543210) b0123456789876543210 = Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210 + Lambda_0123456789876543210Sym1KindInference :: 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 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) - data Lambda_0123456789876543210Sym0 a0123456789876543210 + data Lambda_0123456789876543210Sym0 x0123456789876543210 where - Lambda_0123456789876543210Sym0KindInference :: forall a0123456789876543210 + Lambda_0123456789876543210Sym0KindInference :: forall x0123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 a0123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 a0123456789876543210 = Lambda_0123456789876543210Sym1 a0123456789876543210 + 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 a) b) x + 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 @@ -238,11 +238,11 @@ 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 x y z arg_0123456789876543210 arg_0123456789876543210 t where - Case_0123456789876543210 x y z arg_0123456789876543210 arg_0123456789876543210 '(_, + 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 x y z arg_0123456789876543210 arg_0123456789876543210 (Apply (Apply Tuple2Sym0 arg_0123456789876543210) arg_0123456789876543210) + 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 @@ -323,10 +323,10 @@ 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 x y arg_0123456789876543210 t where - Case_0123456789876543210 x y arg_0123456789876543210 _ = x + 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 x y arg_0123456789876543210 arg_0123456789876543210 + 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 @@ -359,10 +359,10 @@ 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 x arg_0123456789876543210 a_0123456789876543210 t where - Case_0123456789876543210 x arg_0123456789876543210 a_0123456789876543210 _ = x + 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 x arg_0123456789876543210 a_0123456789876543210 arg_0123456789876543210 + 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 @@ -675,7 +675,7 @@ Singletons/Lambdas.hs:(0,0)-(0,0): Splicing declarations -> case sArg_0123456789876543210 of { (_ :: Sing arg_0123456789876543210) -> (id - @(Sing (Case_0123456789876543210 x arg_0123456789876543210 arg_0123456789876543210))) + @(Sing (Case_0123456789876543210 arg_0123456789876543210 x arg_0123456789876543210))) (case sArg_0123456789876543210 of { SFoo (sA :: Sing a) _ -> sA }) }))) sX @@ -686,7 +686,7 @@ Singletons/Lambdas.hs:(0,0)-(0,0): Splicing declarations -> case sArg_0123456789876543210 of { (_ :: Sing arg_0123456789876543210) -> (id - @(Sing (Case_0123456789876543210 x y arg_0123456789876543210 arg_0123456789876543210))) + @(Sing (Case_0123456789876543210 arg_0123456789876543210 x y arg_0123456789876543210))) (case sArg_0123456789876543210 of { STuple2 _ (sB :: Sing b) -> sB }) }))) ((applySing ((applySing ((singFun2 @Tuple2Sym0) STuple2)) sX)) sY) @@ -698,12 +698,12 @@ Singletons/Lambdas.hs:(0,0)-(0,0): Splicing declarations -> case sX of { (_ :: Sing x) -> (singFun1 - @(Apply (Apply (Apply Lambda_0123456789876543210Sym0 a) b) x)) + @(Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) a) b)) (\ sArg_0123456789876543210 -> case sArg_0123456789876543210 of { (_ :: Sing arg_0123456789876543210) -> (id - @(Sing (Case_0123456789876543210 a b x arg_0123456789876543210 arg_0123456789876543210))) + @(Sing (Case_0123456789876543210 arg_0123456789876543210 x a b arg_0123456789876543210))) (case sArg_0123456789876543210 of { _ -> sX }) }) }))) sA)) @@ -725,7 +725,7 @@ Singletons/Lambdas.hs:(0,0)-(0,0): Splicing declarations (,) (_ :: Sing arg_0123456789876543210) (_ :: Sing arg_0123456789876543210) -> (id - @(Sing (Case_0123456789876543210 x y z arg_0123456789876543210 arg_0123456789876543210 (Apply (Apply Tuple2Sym0 arg_0123456789876543210) arg_0123456789876543210)))) + @(Sing (Case_0123456789876543210 arg_0123456789876543210 arg_0123456789876543210 x y z (Apply (Apply Tuple2Sym0 arg_0123456789876543210) arg_0123456789876543210)))) (case (applySing ((applySing ((singFun2 @Tuple2Sym0) STuple2)) @@ -747,7 +747,7 @@ Singletons/Lambdas.hs:(0,0)-(0,0): Splicing declarations -> case sArg_0123456789876543210 of { (_ :: Sing arg_0123456789876543210) -> (id - @(Sing (Case_0123456789876543210 x y arg_0123456789876543210 arg_0123456789876543210))) + @(Sing (Case_0123456789876543210 arg_0123456789876543210 x y arg_0123456789876543210))) (case sArg_0123456789876543210 of { _ -> sX }) }))) sY sFoo1 @@ -760,7 +760,7 @@ Singletons/Lambdas.hs:(0,0)-(0,0): Splicing declarations -> case sArg_0123456789876543210 of { (_ :: Sing arg_0123456789876543210) -> (id - @(Sing (Case_0123456789876543210 x arg_0123456789876543210 a_0123456789876543210 arg_0123456789876543210))) + @(Sing (Case_0123456789876543210 arg_0123456789876543210 x a_0123456789876543210 arg_0123456789876543210))) (case sArg_0123456789876543210 of { _ -> sX }) }))) sA_0123456789876543210 sFoo0 diff --git a/tests/compile-and-dump/Singletons/LetStatements.ghc86.template b/tests/compile-and-dump/Singletons/LetStatements.ghc86.template index 86013ac7..c797c8e7 100644 --- a/tests/compile-and-dump/Singletons/LetStatements.ghc86.template +++ b/tests/compile-and-dump/Singletons/LetStatements.ghc86.template @@ -189,23 +189,12 @@ Singletons/LetStatements.hs:(0,0)-(0,0): Splicing declarations foo13_ y = y foo14 :: Nat -> (Nat, Nat) foo14 x = let (y, z) = (Succ x, x) in (z, y) - type family Case_0123456789876543210 x t where - Case_0123456789876543210 x '(y_0123456789876543210, - _) = y_0123456789876543210 type family Case_0123456789876543210 x t where Case_0123456789876543210 x '(_, y_0123456789876543210) = y_0123456789876543210 - type Let0123456789876543210YSym1 x0123456789876543210 = - Let0123456789876543210Y x0123456789876543210 - instance SuppressUnusedWarnings Let0123456789876543210YSym0 where - suppressUnusedWarnings - = snd (((,) Let0123456789876543210YSym0KindInference) ()) - data Let0123456789876543210YSym0 x0123456789876543210 - where - Let0123456789876543210YSym0KindInference :: forall x0123456789876543210 - arg. SameKind (Apply Let0123456789876543210YSym0 arg) (Let0123456789876543210YSym1 arg) => - Let0123456789876543210YSym0 x0123456789876543210 - type instance Apply Let0123456789876543210YSym0 x0123456789876543210 = Let0123456789876543210Y x0123456789876543210 + type family Case_0123456789876543210 x t where + Case_0123456789876543210 x '(y_0123456789876543210, + _) = y_0123456789876543210 type Let0123456789876543210ZSym1 x0123456789876543210 = Let0123456789876543210Z x0123456789876543210 instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where @@ -217,6 +206,17 @@ Singletons/LetStatements.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) => Let0123456789876543210ZSym0 x0123456789876543210 type instance Apply Let0123456789876543210ZSym0 x0123456789876543210 = Let0123456789876543210Z x0123456789876543210 + type Let0123456789876543210YSym1 x0123456789876543210 = + Let0123456789876543210Y x0123456789876543210 + instance SuppressUnusedWarnings Let0123456789876543210YSym0 where + suppressUnusedWarnings + = snd (((,) Let0123456789876543210YSym0KindInference) ()) + data Let0123456789876543210YSym0 x0123456789876543210 + where + Let0123456789876543210YSym0KindInference :: forall x0123456789876543210 + arg. SameKind (Apply Let0123456789876543210YSym0 arg) (Let0123456789876543210YSym1 arg) => + Let0123456789876543210YSym0 x0123456789876543210 + type instance Apply Let0123456789876543210YSym0 x0123456789876543210 = Let0123456789876543210Y x0123456789876543210 type Let0123456789876543210X_0123456789876543210Sym1 x0123456789876543210 = Let0123456789876543210X_0123456789876543210 x0123456789876543210 instance SuppressUnusedWarnings Let0123456789876543210X_0123456789876543210Sym0 where @@ -230,10 +230,10 @@ 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_0123456789876543210 x0123456789876543210 - type family Let0123456789876543210Y x where - Let0123456789876543210Y x = Case_0123456789876543210 x (Let0123456789876543210X_0123456789876543210Sym1 x) 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 = @@ -367,40 +367,40 @@ Singletons/LetStatements.hs:(0,0)-(0,0): Splicing declarations 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 x a_0123456789876543210 t where - Lambda_0123456789876543210 x a_0123456789876543210 x = x - type Lambda_0123456789876543210Sym3 x0123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 = - Lambda_0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 x0123456789876543210) where + 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 suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) - data Lambda_0123456789876543210Sym2 x0123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + data Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 x0123456789876543210 t0123456789876543210 where - Lambda_0123456789876543210Sym2KindInference :: forall x0123456789876543210 - a_01234567898765432100123456789876543210 + Lambda_0123456789876543210Sym2KindInference :: forall a_01234567898765432100123456789876543210 + x0123456789876543210 t0123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 x0123456789876543210 a_01234567898765432100123456789876543210 arg) => - Lambda_0123456789876543210Sym2 x0123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 a_01234567898765432100123456789876543210 x0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where + 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_0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) - data Lambda_0123456789876543210Sym1 x0123456789876543210 a_01234567898765432100123456789876543210 + data Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210 x0123456789876543210 where - Lambda_0123456789876543210Sym1KindInference :: forall x0123456789876543210 - a_01234567898765432100123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) => - Lambda_0123456789876543210Sym1 x0123456789876543210 a_01234567898765432100123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 x0123456789876543210 a_01234567898765432100123456789876543210 + Lambda_0123456789876543210Sym1KindInference :: forall a_01234567898765432100123456789876543210 + x0123456789876543210 + 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 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 + Lambda_0123456789876543210Sym0 a_01234567898765432100123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210 type Let0123456789876543210ZSym2 x0123456789876543210 (a0123456789876543210 :: Nat) = Let0123456789876543210Z x0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Let0123456789876543210ZSym1 x0123456789876543210) where @@ -423,7 +423,7 @@ Singletons/LetStatements.hs:(0,0)-(0,0): Splicing declarations Let0123456789876543210ZSym0 x0123456789876543210 type instance Apply Let0123456789876543210ZSym0 x0123456789876543210 = Let0123456789876543210ZSym1 x0123456789876543210 type family Let0123456789876543210Z x (a :: Nat) :: Nat where - Let0123456789876543210Z x a_0123456789876543210 = Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) a_0123456789876543210) a_0123456789876543210 + 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 = @@ -509,29 +509,29 @@ Singletons/LetStatements.hs:(0,0)-(0,0): Splicing declarations type instance Apply Let0123456789876543210ZSym0 x0123456789876543210 = Let0123456789876543210Z x0123456789876543210 type family Let0123456789876543210Z x :: Nat where Let0123456789876543210Z x = Apply (Let0123456789876543210FSym1 x) x - type Let0123456789876543210ZSym2 x0123456789876543210 y0123456789876543210 = - Let0123456789876543210Z x0123456789876543210 y0123456789876543210 - instance SuppressUnusedWarnings (Let0123456789876543210ZSym1 x0123456789876543210) where + type Let0123456789876543210ZSym2 y0123456789876543210 x0123456789876543210 = + Let0123456789876543210Z y0123456789876543210 x0123456789876543210 + instance SuppressUnusedWarnings (Let0123456789876543210ZSym1 y0123456789876543210) where suppressUnusedWarnings = snd (((,) Let0123456789876543210ZSym1KindInference) ()) - data Let0123456789876543210ZSym1 x0123456789876543210 y0123456789876543210 + data Let0123456789876543210ZSym1 y0123456789876543210 x0123456789876543210 where - Let0123456789876543210ZSym1KindInference :: forall x0123456789876543210 - y0123456789876543210 - arg. SameKind (Apply (Let0123456789876543210ZSym1 x0123456789876543210) arg) (Let0123456789876543210ZSym2 x0123456789876543210 arg) => - Let0123456789876543210ZSym1 x0123456789876543210 y0123456789876543210 - type instance Apply (Let0123456789876543210ZSym1 x0123456789876543210) y0123456789876543210 = Let0123456789876543210Z x0123456789876543210 y0123456789876543210 + Let0123456789876543210ZSym1KindInference :: forall y0123456789876543210 + x0123456789876543210 + arg. SameKind (Apply (Let0123456789876543210ZSym1 y0123456789876543210) arg) (Let0123456789876543210ZSym2 y0123456789876543210 arg) => + Let0123456789876543210ZSym1 y0123456789876543210 x0123456789876543210 + type instance Apply (Let0123456789876543210ZSym1 y0123456789876543210) x0123456789876543210 = Let0123456789876543210Z y0123456789876543210 x0123456789876543210 instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where suppressUnusedWarnings = snd (((,) Let0123456789876543210ZSym0KindInference) ()) - data Let0123456789876543210ZSym0 x0123456789876543210 + data Let0123456789876543210ZSym0 y0123456789876543210 where - Let0123456789876543210ZSym0KindInference :: forall x0123456789876543210 + Let0123456789876543210ZSym0KindInference :: forall y0123456789876543210 arg. SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) => - Let0123456789876543210ZSym0 x0123456789876543210 - type instance Apply Let0123456789876543210ZSym0 x0123456789876543210 = Let0123456789876543210ZSym1 x0123456789876543210 - type family Let0123456789876543210Z x y :: Nat where - Let0123456789876543210Z x y = Apply SuccSym0 y + Let0123456789876543210ZSym0 y0123456789876543210 + type instance Apply Let0123456789876543210ZSym0 y0123456789876543210 = Let0123456789876543210ZSym1 y0123456789876543210 + type family Let0123456789876543210Z y x :: Nat where + Let0123456789876543210Z y x = Apply SuccSym0 y type Let0123456789876543210FSym2 x0123456789876543210 (a0123456789876543210 :: Nat) = Let0123456789876543210F x0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Let0123456789876543210FSym1 x0123456789876543210) where @@ -554,7 +554,7 @@ Singletons/LetStatements.hs:(0,0)-(0,0): Splicing declarations Let0123456789876543210FSym0 x0123456789876543210 type instance Apply Let0123456789876543210FSym0 x0123456789876543210 = Let0123456789876543210FSym1 x0123456789876543210 type family Let0123456789876543210F x (a :: Nat) :: Nat where - Let0123456789876543210F x y = Apply SuccSym0 (Let0123456789876543210ZSym2 x y) + Let0123456789876543210F x y = Apply SuccSym0 (Let0123456789876543210ZSym2 y x) type Let0123456789876543210FSym2 x0123456789876543210 (a0123456789876543210 :: Nat) = Let0123456789876543210F x0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Let0123456789876543210FSym1 x0123456789876543210) where @@ -591,12 +591,12 @@ Singletons/LetStatements.hs:(0,0)-(0,0): Splicing declarations type instance Apply Let0123456789876543210YSym0 x0123456789876543210 = Let0123456789876543210Y x0123456789876543210 type family Let0123456789876543210Y x :: Nat where Let0123456789876543210Y x = Apply SuccSym0 x - type Let0123456789876543210YSym0 = Let0123456789876543210Y type Let0123456789876543210ZSym0 = Let0123456789876543210Z - type family Let0123456789876543210Y where - Let0123456789876543210Y = Apply SuccSym0 ZeroSym0 + type Let0123456789876543210YSym0 = Let0123456789876543210Y type family Let0123456789876543210Z where Let0123456789876543210Z = Apply SuccSym0 Let0123456789876543210YSym0 + type family Let0123456789876543210Y where + Let0123456789876543210Y = Apply SuccSym0 ZeroSym0 type Let0123456789876543210YSym1 x0123456789876543210 = Let0123456789876543210Y x0123456789876543210 instance SuppressUnusedWarnings Let0123456789876543210YSym0 where @@ -814,21 +814,21 @@ Singletons/LetStatements.hs:(0,0)-(0,0): Splicing declarations forall (t :: Nat). Sing t -> Sing (Apply Foo1Sym0 t :: Nat) sFoo14 (sX :: Sing x) = let - sY :: Sing (Let0123456789876543210YSym1 x) sZ :: Sing (Let0123456789876543210ZSym1 x) + sY :: Sing (Let0123456789876543210YSym1 x) sX_0123456789876543210 :: Sing (Let0123456789876543210X_0123456789876543210Sym1 x) - sY + sZ = (id @(Sing (Case_0123456789876543210 x (Let0123456789876543210X_0123456789876543210Sym1 x)))) (case sX_0123456789876543210 of { - STuple2 (sY_0123456789876543210 :: Sing y_0123456789876543210) _ + STuple2 _ (sY_0123456789876543210 :: Sing y_0123456789876543210) -> sY_0123456789876543210 }) - sZ + sY = (id @(Sing (Case_0123456789876543210 x (Let0123456789876543210X_0123456789876543210Sym1 x)))) (case sX_0123456789876543210 of { - STuple2 _ (sY_0123456789876543210 :: Sing y_0123456789876543210) + STuple2 (sY_0123456789876543210 :: Sing y_0123456789876543210) _ -> sY_0123456789876543210 }) sX_0123456789876543210 = (applySing @@ -910,7 +910,7 @@ Singletons/LetStatements.hs:(0,0)-(0,0): Splicing declarations sZ (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((singFun1 - @(Apply (Apply Lambda_0123456789876543210Sym0 x) a_0123456789876543210)) + @(Apply (Apply Lambda_0123456789876543210Sym0 a_0123456789876543210) x)) (\ sX -> case sX of { (_ :: Sing x) -> sX }))) sA_0123456789876543210 in (applySing ((singFun1 @(Let0123456789876543210ZSym1 x)) sZ)) sX @@ -946,7 +946,7 @@ Singletons/LetStatements.hs:(0,0)-(0,0): Splicing declarations Sing t -> Sing (Apply (Let0123456789876543210FSym1 x) t :: Nat) sF (sY :: Sing y) = let - sZ :: Sing (Let0123456789876543210ZSym2 x y :: Nat) + sZ :: Sing (Let0123456789876543210ZSym2 y x :: Nat) sZ = (applySing ((singFun1 @SuccSym0) SSucc)) sY in (applySing ((singFun1 @SuccSym0) SSucc)) sZ in (applySing ((singFun1 @(Let0123456789876543210FSym1 x)) sF)) sX @@ -964,10 +964,10 @@ Singletons/LetStatements.hs:(0,0)-(0,0): Splicing declarations in sY sFoo2 = let - sY :: Sing Let0123456789876543210YSym0 sZ :: Sing Let0123456789876543210ZSym0 - sY = (applySing ((singFun1 @SuccSym0) SSucc)) SZero + sY :: Sing Let0123456789876543210YSym0 sZ = (applySing ((singFun1 @SuccSym0) SSucc)) sY + sY = (applySing ((singFun1 @SuccSym0) SSucc)) SZero in sZ sFoo1 (sX :: Sing x) = let diff --git a/tests/compile-and-dump/Singletons/OverloadedStrings.ghc86.template b/tests/compile-and-dump/Singletons/OverloadedStrings.ghc86.template index fe3165c2..c80d2d27 100644 --- a/tests/compile-and-dump/Singletons/OverloadedStrings.ghc86.template +++ b/tests/compile-and-dump/Singletons/OverloadedStrings.ghc86.template @@ -9,6 +9,7 @@ Singletons/OverloadedStrings.hs:(0,0)-(0,0): Splicing declarations symId x = x foo :: Symbol foo = symId "foo" + type FooSym0 = Foo type SymIdSym1 (a0123456789876543210 :: Symbol) = SymId a0123456789876543210 instance SuppressUnusedWarnings SymIdSym0 where @@ -19,17 +20,16 @@ Singletons/OverloadedStrings.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply SymIdSym0 arg) (SymIdSym1 arg) => SymIdSym0 a0123456789876543210 type instance Apply SymIdSym0 a0123456789876543210 = SymId a0123456789876543210 - type FooSym0 = Foo - type family SymId (a :: Symbol) :: Symbol where - SymId x = x type family Foo :: Symbol where Foo = Apply SymIdSym0 (Data.Singletons.Prelude.IsString.FromString "foo") + type family SymId (a :: Symbol) :: Symbol where + SymId x = x + sFoo :: Sing (FooSym0 :: Symbol) sSymId :: forall (t :: Symbol). Sing t -> Sing (Apply SymIdSym0 t :: Symbol) - sFoo :: Sing (FooSym0 :: Symbol) - sSymId (sX :: Sing x) = sX sFoo = (applySing ((singFun1 @SymIdSym0) sSymId)) (Data.Singletons.Prelude.IsString.sFromString (sing :: Sing "foo")) + sSymId (sX :: Sing x) = sX instance SingI (SymIdSym0 :: (~>) Symbol Symbol) where sing = (singFun1 @SymIdSym0) sSymId diff --git a/tests/compile-and-dump/Singletons/PatternMatching.ghc86.template b/tests/compile-and-dump/Singletons/PatternMatching.ghc86.template index d0073d5f..aafae601 100644 --- a/tests/compile-and-dump/Singletons/PatternMatching.ghc86.template +++ b/tests/compile-and-dump/Singletons/PatternMatching.ghc86.template @@ -231,74 +231,74 @@ Singletons/PatternMatching.hs:(0,0)-(0,0): Splicing declarations type instance Apply Let0123456789876543210TSym0 x0123456789876543210 = Let0123456789876543210TSym1 x0123456789876543210 type family Let0123456789876543210T x y where Let0123456789876543210T x y = Apply (Apply Tuple2Sym0 x) y - type family Case_0123456789876543210 x y a b arg_0123456789876543210 t where - Case_0123456789876543210 x y a b arg_0123456789876543210 _ = a - type family Lambda_0123456789876543210 x y a b t where - Lambda_0123456789876543210 x y a b arg_0123456789876543210 = Case_0123456789876543210 x y a b arg_0123456789876543210 arg_0123456789876543210 - type Lambda_0123456789876543210Sym5 x0123456789876543210 y0123456789876543210 a0123456789876543210 b0123456789876543210 t0123456789876543210 = - Lambda_0123456789876543210 x0123456789876543210 y0123456789876543210 a0123456789876543210 b0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 b0123456789876543210 a0123456789876543210 y0123456789876543210 x0123456789876543210) where + 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 suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym4KindInference) ()) - data Lambda_0123456789876543210Sym4 x0123456789876543210 y0123456789876543210 a0123456789876543210 b0123456789876543210 t0123456789876543210 + data Lambda_0123456789876543210Sym4 a0123456789876543210 b0123456789876543210 x0123456789876543210 y0123456789876543210 t0123456789876543210 where - Lambda_0123456789876543210Sym4KindInference :: forall x0123456789876543210 - y0123456789876543210 - a0123456789876543210 + Lambda_0123456789876543210Sym4KindInference :: forall a0123456789876543210 b0123456789876543210 + x0123456789876543210 + y0123456789876543210 t0123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym4 x0123456789876543210 y0123456789876543210 a0123456789876543210 b0123456789876543210) arg) (Lambda_0123456789876543210Sym5 x0123456789876543210 y0123456789876543210 a0123456789876543210 b0123456789876543210 arg) => - Lambda_0123456789876543210Sym4 x0123456789876543210 y0123456789876543210 a0123456789876543210 b0123456789876543210 t0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym4 b0123456789876543210 a0123456789876543210 y0123456789876543210 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 b0123456789876543210 a0123456789876543210 y0123456789876543210 x0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 a0123456789876543210 y0123456789876543210 x0123456789876543210) where + 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_0123456789876543210 y0123456789876543210 x0123456789876543210 b0123456789876543210 a0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 x0123456789876543210 b0123456789876543210 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) - data Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 a0123456789876543210 b0123456789876543210 + data Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 x0123456789876543210 y0123456789876543210 where - Lambda_0123456789876543210Sym3KindInference :: forall x0123456789876543210 - y0123456789876543210 - a0123456789876543210 + Lambda_0123456789876543210Sym3KindInference :: forall a0123456789876543210 b0123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 a0123456789876543210) arg) (Lambda_0123456789876543210Sym4 x0123456789876543210 y0123456789876543210 a0123456789876543210 arg) => - Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 a0123456789876543210 b0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym3 a0123456789876543210 y0123456789876543210 x0123456789876543210) b0123456789876543210 = Lambda_0123456789876543210Sym4 a0123456789876543210 y0123456789876543210 x0123456789876543210 b0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) 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 x0123456789876543210 b0123456789876543210 a0123456789876543210) y0123456789876543210 = Lambda_0123456789876543210Sym4 x0123456789876543210 b0123456789876543210 a0123456789876543210 y0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 b0123456789876543210 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) - data Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 a0123456789876543210 + data Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210 x0123456789876543210 where - Lambda_0123456789876543210Sym2KindInference :: forall x0123456789876543210 - y0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210) arg) (Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 arg) => - Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 a0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) a0123456789876543210 = Lambda_0123456789876543210Sym3 y0123456789876543210 x0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where + Lambda_0123456789876543210Sym2KindInference :: forall a0123456789876543210 + b0123456789876543210 + x0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210) arg) (Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 arg) => + Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210 x0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym2 b0123456789876543210 a0123456789876543210) x0123456789876543210 = Lambda_0123456789876543210Sym3 b0123456789876543210 a0123456789876543210 x0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) - data Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 + data Lambda_0123456789876543210Sym1 a0123456789876543210 b0123456789876543210 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 + Lambda_0123456789876543210Sym1KindInference :: forall a0123456789876543210 + b0123456789876543210 + arg. SameKind (Apply (Lambda_0123456789876543210Sym1 a0123456789876543210) arg) (Lambda_0123456789876543210Sym2 a0123456789876543210 arg) => + Lambda_0123456789876543210Sym1 a0123456789876543210 b0123456789876543210 + type instance Apply (Lambda_0123456789876543210Sym1 a0123456789876543210) b0123456789876543210 = Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) - data Lambda_0123456789876543210Sym0 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 + Lambda_0123456789876543210Sym0 a0123456789876543210 + type instance Apply Lambda_0123456789876543210Sym0 a0123456789876543210 = Lambda_0123456789876543210Sym1 a0123456789876543210 type family Case_0123456789876543210 x y t where Case_0123456789876543210 x y '(a, - b) = Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) a) b) b - type family Case_0123456789876543210 x y arg_0123456789876543210 t where - Case_0123456789876543210 x y arg_0123456789876543210 _ = x + b) = Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 a) b) x) y) b + 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 x y arg_0123456789876543210 arg_0123456789876543210 + 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 @@ -331,36 +331,36 @@ Singletons/PatternMatching.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 t where - Case_0123456789876543210 '[_, - y_0123456789876543210, - 'Succ _] = y_0123456789876543210 type family Case_0123456789876543210 t where Case_0123456789876543210 '[_, _, 'Succ y_0123456789876543210] = y_0123456789876543210 type family Case_0123456789876543210 t where - Case_0123456789876543210 '(y_0123456789876543210, + Case_0123456789876543210 '[_, + y_0123456789876543210, + 'Succ _] = y_0123456789876543210 + type family Case_0123456789876543210 t where + Case_0123456789876543210 '(_, _, - _) = y_0123456789876543210 + y_0123456789876543210) = y_0123456789876543210 type family Case_0123456789876543210 t where Case_0123456789876543210 '(_, y_0123456789876543210, _) = y_0123456789876543210 type family Case_0123456789876543210 t where - Case_0123456789876543210 '(_, + Case_0123456789876543210 '(y_0123456789876543210, _, - y_0123456789876543210) = y_0123456789876543210 + _) = y_0123456789876543210 type family Case_0123456789876543210 t where - Case_0123456789876543210 ( 'Pair ( 'Pair y_0123456789876543210 _) _) = y_0123456789876543210 + Case_0123456789876543210 ( 'Pair ( 'Pair _ _) y_0123456789876543210) = y_0123456789876543210 type family Case_0123456789876543210 t where Case_0123456789876543210 ( 'Pair ( 'Pair _ y_0123456789876543210) _) = y_0123456789876543210 type family Case_0123456789876543210 t where - Case_0123456789876543210 ( 'Pair ( 'Pair _ _) y_0123456789876543210) = y_0123456789876543210 - type family Case_0123456789876543210 t where - Case_0123456789876543210 ( 'Pair y_0123456789876543210 _) = y_0123456789876543210 + Case_0123456789876543210 ( 'Pair ( 'Pair y_0123456789876543210 _) _) = y_0123456789876543210 type family Case_0123456789876543210 t where 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 @@ -398,19 +398,19 @@ Singletons/PatternMatching.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Foo1Sym0 arg) (Foo1Sym1 arg) => Foo1Sym0 a0123456789876543210 type instance Apply Foo1Sym0 a0123456789876543210 = Foo1 a0123456789876543210 - type LszSym0 = Lsz type BlimySym0 = Blimy - type TfSym0 = Tf - type TjzSym0 = Tjz - type TtSym0 = Tt - type JzSym0 = Jz - type ZzSym0 = Zz - type FlsSym0 = Fls - type SzSym0 = Sz - type LzSym0 = Lz + type LszSym0 = Lsz type X_0123456789876543210Sym0 = X_0123456789876543210 + type TtSym0 = Tt + type TjzSym0 = Tjz + type TfSym0 = Tf type X_0123456789876543210Sym0 = X_0123456789876543210 + type FlsSym0 = Fls + type ZzSym0 = Zz + type JzSym0 = Jz type X_0123456789876543210Sym0 = X_0123456789876543210 + type LzSym0 = Lz + type SzSym0 = Sz type X_0123456789876543210Sym0 = X_0123456789876543210 type family Silly (a :: a) :: () where Silly x = Case_0123456789876543210 x x @@ -420,53 +420,53 @@ Singletons/PatternMatching.hs:(0,0)-(0,0): Splicing declarations type family Foo1 (a :: (a, b)) :: a where Foo1 '(x, y) = Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) y - type family Lsz :: Nat where - Lsz = Case_0123456789876543210 X_0123456789876543210Sym0 type family Blimy where Blimy = Case_0123456789876543210 X_0123456789876543210Sym0 - type family Tf where - Tf = Case_0123456789876543210 X_0123456789876543210Sym0 - type family Tjz where - Tjz = Case_0123456789876543210 X_0123456789876543210Sym0 + type family Lsz :: Nat where + Lsz = Case_0123456789876543210 X_0123456789876543210Sym0 + type family X_0123456789876543210 where + X_0123456789876543210 = AListSym0 type family Tt where Tt = Case_0123456789876543210 X_0123456789876543210Sym0 - type family Jz where - Jz = Case_0123456789876543210 X_0123456789876543210Sym0 - type family Zz where - Zz = Case_0123456789876543210 X_0123456789876543210Sym0 + type family Tjz where + Tjz = Case_0123456789876543210 X_0123456789876543210Sym0 + type family Tf where + Tf = Case_0123456789876543210 X_0123456789876543210Sym0 + type family X_0123456789876543210 where + X_0123456789876543210 = TupleSym0 type family Fls :: Bool where Fls = Case_0123456789876543210 X_0123456789876543210Sym0 - type family Sz where - Sz = Case_0123456789876543210 X_0123456789876543210Sym0 + type family Zz where + Zz = Case_0123456789876543210 X_0123456789876543210Sym0 + type family Jz where + Jz = Case_0123456789876543210 X_0123456789876543210Sym0 + type family X_0123456789876543210 where + X_0123456789876543210 = ComplexSym0 type family Lz where Lz = Case_0123456789876543210 X_0123456789876543210Sym0 + type family Sz where + Sz = Case_0123456789876543210 X_0123456789876543210Sym0 type family X_0123456789876543210 where X_0123456789876543210 = PrSym0 - type family X_0123456789876543210 where - X_0123456789876543210 = ComplexSym0 - type family X_0123456789876543210 where - X_0123456789876543210 = TupleSym0 - type family X_0123456789876543210 where - X_0123456789876543210 = AListSym0 sSilly :: forall a (t :: a). Sing t -> Sing (Apply SillySym0 t :: ()) sFoo2 :: forall a b (t :: (a, b)). Sing t -> Sing (Apply Foo2Sym0 t :: a) sFoo1 :: forall a b (t :: (a, b)). Sing t -> Sing (Apply Foo1Sym0 t :: a) - sLsz :: Sing (LszSym0 :: Nat) sBlimy :: Sing BlimySym0 - sTf :: Sing TfSym0 - sTjz :: Sing TjzSym0 - sTt :: Sing TtSym0 - sJz :: Sing JzSym0 - sZz :: Sing ZzSym0 - sFls :: Sing (FlsSym0 :: Bool) - sSz :: Sing SzSym0 - sLz :: Sing LzSym0 + sLsz :: Sing (LszSym0 :: Nat) sX_0123456789876543210 :: Sing X_0123456789876543210Sym0 + sTt :: Sing TtSym0 + sTjz :: Sing TjzSym0 + sTf :: Sing TfSym0 sX_0123456789876543210 :: Sing X_0123456789876543210Sym0 + sFls :: Sing (FlsSym0 :: Bool) + sZz :: Sing ZzSym0 + sJz :: Sing JzSym0 sX_0123456789876543210 :: Sing X_0123456789876543210Sym0 + sLz :: Sing LzSym0 + sSz :: Sing SzSym0 sX_0123456789876543210 :: Sing X_0123456789876543210Sym0 sSilly (sX :: Sing x) = (id @(Sing (Case_0123456789876543210 x x :: ()))) @@ -483,12 +483,12 @@ Singletons/PatternMatching.hs:(0,0)-(0,0): Splicing declarations STuple2 (sA :: Sing a) (sB :: Sing b) -> (applySing ((singFun1 - @(Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) a) b)) + @(Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 a) b) x) y)) (\ sArg_0123456789876543210 -> case sArg_0123456789876543210 of { (_ :: Sing arg_0123456789876543210) -> (id - @(Sing (Case_0123456789876543210 x y a b arg_0123456789876543210 arg_0123456789876543210))) + @(Sing (Case_0123456789876543210 arg_0123456789876543210 a b x y arg_0123456789876543210))) (case sArg_0123456789876543210 of { _ -> sA }) }))) sB }) sFoo1 (STuple2 (sX :: Sing x) (sY :: Sing y)) @@ -498,17 +498,9 @@ Singletons/PatternMatching.hs:(0,0)-(0,0): Splicing declarations -> case sArg_0123456789876543210 of { (_ :: Sing arg_0123456789876543210) -> (id - @(Sing (Case_0123456789876543210 x y arg_0123456789876543210 arg_0123456789876543210))) + @(Sing (Case_0123456789876543210 arg_0123456789876543210 x y arg_0123456789876543210))) (case sArg_0123456789876543210 of { _ -> sX }) }))) sY - sLsz - = (id - @(Sing (Case_0123456789876543210 X_0123456789876543210Sym0 :: Nat))) - (case sX_0123456789876543210 of { - SCons _ - (SCons (sY_0123456789876543210 :: Sing y_0123456789876543210) - (SCons (SSucc _) SNil)) - -> sY_0123456789876543210 }) sBlimy = (id @(Sing (Case_0123456789876543210 X_0123456789876543210Sym0))) (case sX_0123456789876543210 of { @@ -517,35 +509,31 @@ Singletons/PatternMatching.hs:(0,0)-(0,0): Splicing declarations (SCons (SSucc (sY_0123456789876543210 :: Sing y_0123456789876543210)) SNil)) -> sY_0123456789876543210 }) - sTf - = (id @(Sing (Case_0123456789876543210 X_0123456789876543210Sym0))) - (case sX_0123456789876543210 of { - STuple3 (sY_0123456789876543210 :: Sing y_0123456789876543210) _ _ - -> sY_0123456789876543210 }) - sTjz - = (id @(Sing (Case_0123456789876543210 X_0123456789876543210Sym0))) + sLsz + = (id + @(Sing (Case_0123456789876543210 X_0123456789876543210Sym0 :: Nat))) (case sX_0123456789876543210 of { - STuple3 _ (sY_0123456789876543210 :: Sing y_0123456789876543210) _ + SCons _ + (SCons (sY_0123456789876543210 :: Sing y_0123456789876543210) + (SCons (SSucc _) SNil)) -> sY_0123456789876543210 }) + sX_0123456789876543210 = sAList sTt = (id @(Sing (Case_0123456789876543210 X_0123456789876543210Sym0))) (case sX_0123456789876543210 of { STuple3 _ _ (sY_0123456789876543210 :: Sing y_0123456789876543210) -> sY_0123456789876543210 }) - sJz + sTjz = (id @(Sing (Case_0123456789876543210 X_0123456789876543210Sym0))) (case sX_0123456789876543210 of { - SPair (SPair (sY_0123456789876543210 :: Sing y_0123456789876543210) - _) - _ + STuple3 _ (sY_0123456789876543210 :: Sing y_0123456789876543210) _ -> sY_0123456789876543210 }) - sZz + sTf = (id @(Sing (Case_0123456789876543210 X_0123456789876543210Sym0))) (case sX_0123456789876543210 of { - SPair (SPair _ - (sY_0123456789876543210 :: Sing y_0123456789876543210)) - _ + STuple3 (sY_0123456789876543210 :: Sing y_0123456789876543210) _ _ -> sY_0123456789876543210 }) + sX_0123456789876543210 = sTuple sFls = (id @(Sing (Case_0123456789876543210 X_0123456789876543210Sym0 :: Bool))) @@ -553,20 +541,32 @@ Singletons/PatternMatching.hs:(0,0)-(0,0): Splicing declarations SPair (SPair _ _) (sY_0123456789876543210 :: Sing y_0123456789876543210) -> sY_0123456789876543210 }) - sSz + sZz = (id @(Sing (Case_0123456789876543210 X_0123456789876543210Sym0))) (case sX_0123456789876543210 of { - SPair (sY_0123456789876543210 :: Sing y_0123456789876543210) _ + SPair (SPair _ + (sY_0123456789876543210 :: Sing y_0123456789876543210)) + _ -> sY_0123456789876543210 }) + sJz + = (id @(Sing (Case_0123456789876543210 X_0123456789876543210Sym0))) + (case sX_0123456789876543210 of { + SPair (SPair (sY_0123456789876543210 :: Sing y_0123456789876543210) + _) + _ + -> sY_0123456789876543210 }) + sX_0123456789876543210 = sComplex sLz = (id @(Sing (Case_0123456789876543210 X_0123456789876543210Sym0))) (case sX_0123456789876543210 of { SPair _ (sY_0123456789876543210 :: Sing y_0123456789876543210) -> sY_0123456789876543210 }) + sSz + = (id @(Sing (Case_0123456789876543210 X_0123456789876543210Sym0))) + (case sX_0123456789876543210 of { + SPair (sY_0123456789876543210 :: Sing y_0123456789876543210) _ + -> sY_0123456789876543210 }) sX_0123456789876543210 = sPr - sX_0123456789876543210 = sComplex - sX_0123456789876543210 = sTuple - sX_0123456789876543210 = sAList instance SingI (SillySym0 :: (~>) a ()) where sing = (singFun1 @SillySym0) sSilly instance SingI (Foo2Sym0 :: (~>) (a, b) a) where diff --git a/tests/compile-and-dump/Singletons/Records.ghc86.template b/tests/compile-and-dump/Singletons/Records.ghc86.template index 5af825cc..44795860 100644 --- a/tests/compile-and-dump/Singletons/Records.ghc86.template +++ b/tests/compile-and-dump/Singletons/Records.ghc86.template @@ -3,17 +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 Field1Sym1 (a0123456789876543210 :: Record a0123456789876543210) = - Field1 a0123456789876543210 - instance SuppressUnusedWarnings Field1Sym0 where - suppressUnusedWarnings = snd (((,) Field1Sym0KindInference) ()) - data Field1Sym0 :: forall a0123456789876543210. - (~>) (Record a0123456789876543210) a0123456789876543210 - where - Field1Sym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply Field1Sym0 arg) (Field1Sym1 arg) => - Field1Sym0 a0123456789876543210 - type instance Apply Field1Sym0 a0123456789876543210 = Field1 a0123456789876543210 type Field2Sym1 (a0123456789876543210 :: Record a0123456789876543210) = Field2 a0123456789876543210 instance SuppressUnusedWarnings Field2Sym0 where @@ -25,10 +14,21 @@ Singletons/Records.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply Field2Sym0 arg) (Field2Sym1 arg) => Field2Sym0 a0123456789876543210 type instance Apply Field2Sym0 a0123456789876543210 = Field2 a0123456789876543210 - type family Field1 (a :: Record a) :: a where - Field1 (MkRecord field _) = field + type Field1Sym1 (a0123456789876543210 :: Record a0123456789876543210) = + Field1 a0123456789876543210 + instance SuppressUnusedWarnings Field1Sym0 where + suppressUnusedWarnings = snd (((,) Field1Sym0KindInference) ()) + data Field1Sym0 :: forall a0123456789876543210. + (~>) (Record a0123456789876543210) a0123456789876543210 + where + Field1Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Field1Sym0 arg) (Field1Sym1 arg) => + Field1Sym0 a0123456789876543210 + type instance Apply Field1Sym0 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 diff --git a/tests/compile-and-dump/Singletons/ReturnFunc.ghc86.template b/tests/compile-and-dump/Singletons/ReturnFunc.ghc86.template index 02f3a31e..45b42e47 100644 --- a/tests/compile-and-dump/Singletons/ReturnFunc.ghc86.template +++ b/tests/compile-and-dump/Singletons/ReturnFunc.ghc86.template @@ -13,17 +13,6 @@ Singletons/ReturnFunc.hs:(0,0)-(0,0): Splicing declarations id x = x idFoo :: c -> a -> a idFoo _ = id - type IdSym1 (a0123456789876543210 :: a0123456789876543210) = - Id a0123456789876543210 - instance SuppressUnusedWarnings IdSym0 where - suppressUnusedWarnings = snd (((,) IdSym0KindInference) ()) - data IdSym0 :: forall a0123456789876543210. - (~>) a0123456789876543210 a0123456789876543210 - where - IdSym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply IdSym0 arg) (IdSym1 arg) => - IdSym0 a0123456789876543210 - type instance Apply IdSym0 a0123456789876543210 = Id a0123456789876543210 type IdFooSym2 (a0123456789876543210 :: c0123456789876543210) (a0123456789876543210 :: a0123456789876543210) = IdFoo a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (IdFooSym1 a0123456789876543210) where @@ -38,13 +27,24 @@ Singletons/ReturnFunc.hs:(0,0)-(0,0): Splicing declarations type instance Apply (IdFooSym1 a0123456789876543210) a0123456789876543210 = IdFoo a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings IdFooSym0 where suppressUnusedWarnings = snd (((,) IdFooSym0KindInference) ()) - data IdFooSym0 :: forall a0123456789876543210 c0123456789876543210. + 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 + instance SuppressUnusedWarnings IdSym0 where + suppressUnusedWarnings = snd (((,) IdSym0KindInference) ()) + data IdSym0 :: forall a0123456789876543210. + (~>) a0123456789876543210 a0123456789876543210 + where + IdSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply IdSym0 arg) (IdSym1 arg) => + IdSym0 a0123456789876543210 + type instance Apply IdSym0 a0123456789876543210 = Id a0123456789876543210 type ReturnFuncSym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) = ReturnFunc a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (ReturnFuncSym1 a0123456789876543210) where @@ -64,32 +64,32 @@ Singletons/ReturnFunc.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply ReturnFuncSym0 arg) (ReturnFuncSym1 arg) => ReturnFuncSym0 a0123456789876543210 type instance Apply ReturnFuncSym0 a0123456789876543210 = ReturnFuncSym1 a0123456789876543210 - type family Id (a :: a) :: a where - Id x = x type family IdFoo (a :: c) (a :: a) :: a where IdFoo _ a_0123456789876543210 = Apply IdSym0 a_0123456789876543210 + type family Id (a :: a) :: a where + Id x = x type family ReturnFunc (a :: Nat) (a :: Nat) :: Nat where ReturnFunc _ a_0123456789876543210 = Apply SuccSym0 a_0123456789876543210 - sId :: forall a (t :: a). Sing t -> Sing (Apply IdSym0 t :: a) sIdFoo :: forall c a (t :: c) (t :: a). Sing t -> Sing t -> Sing (Apply (Apply IdFooSym0 t) t :: a) + sId :: forall a (t :: a). Sing t -> Sing (Apply IdSym0 t :: a) sReturnFunc :: forall (t :: Nat) (t :: Nat). Sing t -> Sing t -> Sing (Apply (Apply ReturnFuncSym0 t) t :: Nat) - sId (sX :: Sing x) = sX sIdFoo _ (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((singFun1 @IdSym0) sId)) sA_0123456789876543210 + sId (sX :: Sing x) = sX sReturnFunc _ (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((singFun1 @SuccSym0) SSucc)) sA_0123456789876543210 - instance SingI (IdSym0 :: (~>) a a) where - sing = (singFun1 @IdSym0) sId instance SingI (IdFooSym0 :: (~>) c ((~>) a a)) where sing = (singFun2 @IdFooSym0) sIdFoo instance SingI d => SingI (IdFooSym1 (d :: c) :: (~>) a a) where sing = (singFun1 @(IdFooSym1 (d :: c))) (sIdFoo (sing @d)) + instance SingI (IdSym0 :: (~>) a a) where + sing = (singFun1 @IdSym0) sId instance SingI (ReturnFuncSym0 :: (~>) Nat ((~>) Nat Nat)) where sing = (singFun2 @ReturnFuncSym0) sReturnFunc instance SingI d => diff --git a/tests/compile-and-dump/Singletons/Sections.ghc86.template b/tests/compile-and-dump/Singletons/Sections.ghc86.template index 00d34878..d2b8a9c5 100644 --- a/tests/compile-and-dump/Singletons/Sections.ghc86.template +++ b/tests/compile-and-dump/Singletons/Sections.ghc86.template @@ -32,6 +32,9 @@ 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_0123456789876543210 t0123456789876543210 + type Foo3Sym0 = Foo3 + type Foo2Sym0 = Foo2 + type Foo1Sym0 = Foo1 type (+@#@$$$) (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) = (+) a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings ((+@#@$$) a0123456789876543210) where @@ -51,33 +54,33 @@ Singletons/Sections.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (+@#@$) arg) ((+@#@$$) arg) => (+@#@$) a0123456789876543210 type instance Apply (+@#@$) a0123456789876543210 = (+@#@$$) a0123456789876543210 - type Foo1Sym0 = Foo1 - type Foo2Sym0 = Foo2 - type Foo3Sym0 = Foo3 + 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 + Foo2 = Apply (Apply MapSym0 Lambda_0123456789876543210Sym0) (Apply (Apply (:@#@$) ZeroSym0) (Apply (Apply (:@#@$) (Apply SuccSym0 ZeroSym0)) '[])) + type family Foo1 :: [Nat] where + Foo1 = Apply (Apply MapSym0 (Apply (+@#@$) (Apply SuccSym0 ZeroSym0))) (Apply (Apply (:@#@$) ZeroSym0) (Apply (Apply (:@#@$) (Apply SuccSym0 ZeroSym0)) '[])) type family (+) (a :: Nat) (a :: Nat) :: Nat where (+) 'Zero m = m (+) ( 'Succ n) m = Apply SuccSym0 (Apply (Apply (+@#@$) n) m) - type family Foo1 :: [Nat] where - Foo1 = Apply (Apply MapSym0 (Apply (+@#@$) (Apply SuccSym0 ZeroSym0))) (Apply (Apply (:@#@$) ZeroSym0) (Apply (Apply (:@#@$) (Apply SuccSym0 ZeroSym0)) '[])) - type family Foo2 :: [Nat] where - Foo2 = Apply (Apply MapSym0 Lambda_0123456789876543210Sym0) (Apply (Apply (:@#@$) ZeroSym0) (Apply (Apply (:@#@$) (Apply SuccSym0 ZeroSym0)) '[])) - 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)) '[])) + sFoo3 :: Sing (Foo3Sym0 :: [Nat]) + sFoo2 :: Sing (Foo2Sym0 :: [Nat]) + sFoo1 :: Sing (Foo1Sym0 :: [Nat]) (%+) :: forall (t :: Nat) (t :: Nat). Sing t -> Sing t -> Sing (Apply (Apply (+@#@$) t) t :: Nat) - sFoo1 :: Sing (Foo1Sym0 :: [Nat]) - sFoo2 :: Sing (Foo2Sym0 :: [Nat]) - sFoo3 :: Sing (Foo3Sym0 :: [Nat]) - (%+) SZero (sM :: Sing m) = sM - (%+) (SSucc (sN :: Sing n)) (sM :: Sing m) - = (applySing ((singFun1 @SuccSym0) SSucc)) - ((applySing ((applySing ((singFun2 @(+@#@$)) (%+))) sN)) sM) - sFoo1 + sFoo3 = (applySing - ((applySing ((singFun2 @MapSym0) sMap)) - ((applySing ((singFun2 @(+@#@$)) (%+))) - ((applySing ((singFun1 @SuccSym0) SSucc)) SZero)))) + ((applySing + ((applySing ((singFun3 @ZipWithSym0) sZipWith)) + ((singFun2 @(+@#@$)) (%+)))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) + SNil)))) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SZero)) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) @@ -98,23 +101,20 @@ Singletons/Sections.hs:(0,0)-(0,0): Splicing declarations ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) SNil)) - sFoo3 + sFoo1 = (applySing - ((applySing - ((applySing ((singFun3 @ZipWithSym0) sZipWith)) - ((singFun2 @(+@#@$)) (%+)))) - ((applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) - ((applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) - SNil)))) + ((applySing ((singFun2 @MapSym0) sMap)) + ((applySing ((singFun2 @(+@#@$)) (%+))) + ((applySing ((singFun1 @SuccSym0) SSucc)) SZero)))) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SZero)) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) SNil)) + (%+) SZero (sM :: Sing m) = sM + (%+) (SSucc (sN :: Sing n)) (sM :: Sing m) + = (applySing ((singFun1 @SuccSym0) SSucc)) + ((applySing ((applySing ((singFun2 @(+@#@$)) (%+))) sN)) sM) instance SingI ((+@#@$) :: (~>) Nat ((~>) Nat Nat)) where sing = (singFun2 @(+@#@$)) (%+) instance SingI d => diff --git a/tests/compile-and-dump/Singletons/ShowDeriving.ghc86.template b/tests/compile-and-dump/Singletons/ShowDeriving.ghc86.template index 0b931bb7..aca0c577 100644 --- a/tests/compile-and-dump/Singletons/ShowDeriving.ghc86.template +++ b/tests/compile-and-dump/Singletons/ShowDeriving.ghc86.template @@ -24,16 +24,6 @@ Singletons/ShowDeriving.hs:(0,0)-(0,0): Splicing declarations data Foo3 = MkFoo3 {getFoo3a :: Bool, *** :: Bool} deriving Show - type GetFoo3aSym1 (a0123456789876543210 :: Foo3) = - GetFoo3a a0123456789876543210 - instance SuppressUnusedWarnings GetFoo3aSym0 where - suppressUnusedWarnings = snd (((,) GetFoo3aSym0KindInference) ()) - data GetFoo3aSym0 :: (~>) Foo3 Bool - where - GetFoo3aSym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply GetFoo3aSym0 arg) (GetFoo3aSym1 arg) => - GetFoo3aSym0 a0123456789876543210 - type instance Apply GetFoo3aSym0 a0123456789876543210 = GetFoo3a a0123456789876543210 type (***@#@$$) (a0123456789876543210 :: Foo3) = (***) a0123456789876543210 instance SuppressUnusedWarnings (***@#@$) where @@ -44,10 +34,20 @@ Singletons/ShowDeriving.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply (***@#@$) arg) ((***@#@$$) arg) => (***@#@$) a0123456789876543210 type instance Apply (***@#@$) a0123456789876543210 = (***) a0123456789876543210 - type family GetFoo3a (a :: Foo3) :: Bool where - GetFoo3a (MkFoo3 field _) = field + type GetFoo3aSym1 (a0123456789876543210 :: Foo3) = + GetFoo3a a0123456789876543210 + instance SuppressUnusedWarnings GetFoo3aSym0 where + suppressUnusedWarnings = snd (((,) GetFoo3aSym0KindInference) ()) + data GetFoo3aSym0 :: (~>) Foo3 Bool + where + GetFoo3aSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply GetFoo3aSym0 arg) (GetFoo3aSym1 arg) => + GetFoo3aSym0 a0123456789876543210 + type instance Apply GetFoo3aSym0 a0123456789876543210 = 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 @@ -267,9 +267,9 @@ Singletons/ShowDeriving.hs:(0,0)-(0,0): Splicing declarations type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 instance PShow Foo3 where type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a - infixl 5 `SMkFoo2b` - infixl 5 :%*: infixl 5 :%&: + infixl 5 :%*: + infixl 5 `SMkFoo2b` data instance Sing :: Foo1 -> GHC.Types.Type where SMkFoo1 :: Sing MkFoo1 type SFoo1 = (Sing :: Foo1 -> GHC.Types.Type) diff --git a/tests/compile-and-dump/Singletons/T145.ghc86.template b/tests/compile-and-dump/Singletons/T145.ghc86.template index 08db61b5..70e5d7c3 100644 --- a/tests/compile-and-dump/Singletons/T145.ghc86.template +++ b/tests/compile-and-dump/Singletons/T145.ghc86.template @@ -18,7 +18,7 @@ Singletons/T145.hs:(0,0)-(0,0): Splicing declarations type instance Apply (ColSym1 arg0123456789876543210) arg0123456789876543210 = Col arg0123456789876543210 arg0123456789876543210 instance SuppressUnusedWarnings ColSym0 where suppressUnusedWarnings = snd (((,) ColSym0KindInference) ()) - data ColSym0 :: forall a0123456789876543210 f0123456789876543210. + data ColSym0 :: forall f0123456789876543210 a0123456789876543210. (~>) (f0123456789876543210 a0123456789876543210) ((~>) a0123456789876543210 Bool) where ColSym0KindInference :: forall arg0123456789876543210 diff --git a/tests/compile-and-dump/Singletons/T159.ghc86.template b/tests/compile-and-dump/Singletons/T159.ghc86.template index 11b2fa7f..27f639df 100644 --- a/tests/compile-and-dump/Singletons/T159.ghc86.template +++ b/tests/compile-and-dump/Singletons/T159.ghc86.template @@ -181,8 +181,8 @@ Singletons/T159.hs:(0,0)-(0,0): Splicing declarations (:||@#@$) t0123456789876543210 type instance Apply (:||@#@$) t0123456789876543210 = (:||@#@$$) t0123456789876543210 infixr 5 :||@#@$ - infixr 5 `SC2` infixr 5 :%|| + infixr 5 `SC2` data instance Sing :: T2 -> GHC.Types.Type where SN2 :: Sing N2 diff --git a/tests/compile-and-dump/Singletons/T163.ghc86.template b/tests/compile-and-dump/Singletons/T163.ghc86.template index 31dcdd01..470adcd5 100644 --- a/tests/compile-and-dump/Singletons/T163.ghc86.template +++ b/tests/compile-and-dump/Singletons/T163.ghc86.template @@ -17,7 +17,7 @@ Singletons/T163.hs:0:0:: Splicing declarations R t0123456789876543210 instance SuppressUnusedWarnings RSym0 where suppressUnusedWarnings = snd (((,) RSym0KindInference) ()) - data RSym0 :: forall a0123456789876543210 b0123456789876543210. + data RSym0 :: forall b0123456789876543210 a0123456789876543210. (~>) b0123456789876543210 ((+) a0123456789876543210 b0123456789876543210) where RSym0KindInference :: forall t0123456789876543210 diff --git a/tests/compile-and-dump/Singletons/T176.ghc86.template b/tests/compile-and-dump/Singletons/T176.ghc86.template index ea920a75..c5c50e2f 100644 --- a/tests/compile-and-dump/Singletons/T176.ghc86.template +++ b/tests/compile-and-dump/Singletons/T176.ghc86.template @@ -22,10 +22,10 @@ Singletons/T176.hs:(0,0)-(0,0): Splicing declarations baz2 :: a quux2 :: Foo2 a => a -> a quux2 x = (x `bar2` baz2) - type family Case_0123456789876543210 x arg_0123456789876543210 t where - Case_0123456789876543210 x arg_0123456789876543210 _ = Baz1Sym0 + type family Case_0123456789876543210 arg_0123456789876543210 x t where + Case_0123456789876543210 arg_0123456789876543210 x _ = Baz1Sym0 type family Lambda_0123456789876543210 x t where - Lambda_0123456789876543210 x arg_0123456789876543210 = Case_0123456789876543210 x arg_0123456789876543210 arg_0123456789876543210 + Lambda_0123456789876543210 x arg_0123456789876543210 = Case_0123456789876543210 arg_0123456789876543210 x arg_0123456789876543210 type Lambda_0123456789876543210Sym2 x0123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where @@ -138,7 +138,7 @@ Singletons/T176.hs:(0,0)-(0,0): Splicing declarations -> case sArg_0123456789876543210 of { (_ :: Sing arg_0123456789876543210) -> (id - @(Sing (Case_0123456789876543210 x arg_0123456789876543210 arg_0123456789876543210))) + @(Sing (Case_0123456789876543210 arg_0123456789876543210 x arg_0123456789876543210))) (case sArg_0123456789876543210 of { _ -> sBaz1 }) })) instance SFoo2 a => SingI (Quux2Sym0 :: (~>) a a) where sing = (singFun1 @Quux2Sym0) sQuux2 diff --git a/tests/compile-and-dump/Singletons/T183.ghc86.template b/tests/compile-and-dump/Singletons/T183.ghc86.template index b6a7f792..26997bc7 100644 --- a/tests/compile-and-dump/Singletons/T183.ghc86.template +++ b/tests/compile-and-dump/Singletons/T183.ghc86.template @@ -74,8 +74,8 @@ Singletons/T183.hs:(0,0)-(0,0): Splicing declarations instance SuppressUnusedWarnings (Let0123456789876543210GSym1 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Let0123456789876543210GSym1KindInference) ()) - data Let0123456789876543210GSym1 x0123456789876543210 :: forall b0123456789876543210 - a. + data Let0123456789876543210GSym1 x0123456789876543210 :: forall a + b0123456789876543210. (~>) a ((~>) b0123456789876543210 a) where Let0123456789876543210GSym1KindInference :: forall x0123456789876543210 diff --git a/tests/compile-and-dump/Singletons/T184.ghc86.template b/tests/compile-and-dump/Singletons/T184.ghc86.template index a466aff7..efa0eadb 100644 --- a/tests/compile-and-dump/Singletons/T184.ghc86.template +++ b/tests/compile-and-dump/Singletons/T184.ghc86.template @@ -48,54 +48,54 @@ Singletons/T184.hs:(0,0)-(0,0): Splicing declarations 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 x t where - Lambda_0123456789876543210 xs ys x y = Apply ReturnSym0 (Apply (Apply Tuple2Sym0 x) y) - type Lambda_0123456789876543210Sym4 xs0123456789876543210 ys0123456789876543210 x0123456789876543210 t0123456789876543210 = - Lambda_0123456789876543210 xs0123456789876543210 ys0123456789876543210 x0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 x0123456789876543210 ys0123456789876543210 xs0123456789876543210) where + 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 suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) - data Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 x0123456789876543210 t0123456789876543210 + data Lambda_0123456789876543210Sym3 x0123456789876543210 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 where - Lambda_0123456789876543210Sym3KindInference :: forall xs0123456789876543210 + Lambda_0123456789876543210Sym3KindInference :: forall x0123456789876543210 + xs0123456789876543210 ys0123456789876543210 - x0123456789876543210 t0123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 x0123456789876543210) arg) (Lambda_0123456789876543210Sym4 xs0123456789876543210 ys0123456789876543210 x0123456789876543210 arg) => - Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 x0123456789876543210 t0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym3 x0123456789876543210 ys0123456789876543210 xs0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 ys0123456789876543210 xs0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 ys0123456789876543210 xs0123456789876543210) where + 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_0123456789876543210 ys0123456789876543210 xs0123456789876543210 x0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 xs0123456789876543210 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) - data Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 x0123456789876543210 + data Lambda_0123456789876543210Sym2 x0123456789876543210 xs0123456789876543210 ys0123456789876543210 where - Lambda_0123456789876543210Sym2KindInference :: forall xs0123456789876543210 + Lambda_0123456789876543210Sym2KindInference :: forall x0123456789876543210 + xs0123456789876543210 ys0123456789876543210 - x0123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210) arg) (Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 arg) => - Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 x0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 ys0123456789876543210 xs0123456789876543210) x0123456789876543210 = Lambda_0123456789876543210Sym3 ys0123456789876543210 xs0123456789876543210 x0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 xs0123456789876543210) where + 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 suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) - data Lambda_0123456789876543210Sym1 xs0123456789876543210 ys0123456789876543210 + data Lambda_0123456789876543210Sym1 x0123456789876543210 xs0123456789876543210 where - Lambda_0123456789876543210Sym1KindInference :: forall xs0123456789876543210 - ys0123456789876543210 - 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 + Lambda_0123456789876543210Sym1KindInference :: 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 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 + 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 xs) ys) x) + 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 @@ -196,11 +196,11 @@ Singletons/T184.hs:(0,0)-(0,0): Splicing declarations 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 xs ys arg_0123456789876543210 t where - Case_0123456789876543210 xs ys arg_0123456789876543210 '(x, + 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 xs ys arg_0123456789876543210 arg_0123456789876543210 + 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 @@ -233,54 +233,54 @@ Singletons/T184.hs:(0,0)-(0,0): Splicing declarations 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 ma mb a t where - Lambda_0123456789876543210 ma mb a b = Apply (Apply (>>@#@$) (Apply GuardSym0 b)) (Apply ReturnSym0 a) - type Lambda_0123456789876543210Sym4 ma0123456789876543210 mb0123456789876543210 a0123456789876543210 t0123456789876543210 = - Lambda_0123456789876543210 ma0123456789876543210 mb0123456789876543210 a0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 a0123456789876543210 mb0123456789876543210 ma0123456789876543210) where + 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 suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) - data Lambda_0123456789876543210Sym3 ma0123456789876543210 mb0123456789876543210 a0123456789876543210 t0123456789876543210 + data Lambda_0123456789876543210Sym3 a0123456789876543210 ma0123456789876543210 mb0123456789876543210 t0123456789876543210 where - Lambda_0123456789876543210Sym3KindInference :: forall ma0123456789876543210 + Lambda_0123456789876543210Sym3KindInference :: forall a0123456789876543210 + ma0123456789876543210 mb0123456789876543210 - a0123456789876543210 t0123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym3 ma0123456789876543210 mb0123456789876543210 a0123456789876543210) arg) (Lambda_0123456789876543210Sym4 ma0123456789876543210 mb0123456789876543210 a0123456789876543210 arg) => - Lambda_0123456789876543210Sym3 ma0123456789876543210 mb0123456789876543210 a0123456789876543210 t0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym3 a0123456789876543210 mb0123456789876543210 ma0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 a0123456789876543210 mb0123456789876543210 ma0123456789876543210 t0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 mb0123456789876543210 ma0123456789876543210) where + 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_0123456789876543210 mb0123456789876543210 ma0123456789876543210 a0123456789876543210 t0123456789876543210 + instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 ma0123456789876543210 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) - data Lambda_0123456789876543210Sym2 ma0123456789876543210 mb0123456789876543210 a0123456789876543210 + data Lambda_0123456789876543210Sym2 a0123456789876543210 ma0123456789876543210 mb0123456789876543210 where - Lambda_0123456789876543210Sym2KindInference :: forall ma0123456789876543210 + Lambda_0123456789876543210Sym2KindInference :: forall a0123456789876543210 + ma0123456789876543210 mb0123456789876543210 - a0123456789876543210 - arg. SameKind (Apply (Lambda_0123456789876543210Sym2 ma0123456789876543210 mb0123456789876543210) arg) (Lambda_0123456789876543210Sym3 ma0123456789876543210 mb0123456789876543210 arg) => - Lambda_0123456789876543210Sym2 ma0123456789876543210 mb0123456789876543210 a0123456789876543210 - type instance Apply (Lambda_0123456789876543210Sym2 mb0123456789876543210 ma0123456789876543210) a0123456789876543210 = Lambda_0123456789876543210Sym3 mb0123456789876543210 ma0123456789876543210 a0123456789876543210 - instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 ma0123456789876543210) where + 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 suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) - data Lambda_0123456789876543210Sym1 ma0123456789876543210 mb0123456789876543210 + data Lambda_0123456789876543210Sym1 a0123456789876543210 ma0123456789876543210 where - Lambda_0123456789876543210Sym1KindInference :: forall ma0123456789876543210 - mb0123456789876543210 - 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 + Lambda_0123456789876543210Sym1KindInference :: 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 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) - data Lambda_0123456789876543210Sym0 ma0123456789876543210 + data Lambda_0123456789876543210Sym0 a0123456789876543210 where - Lambda_0123456789876543210Sym0KindInference :: forall ma0123456789876543210 + Lambda_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => - Lambda_0123456789876543210Sym0 ma0123456789876543210 - type instance Apply Lambda_0123456789876543210Sym0 ma0123456789876543210 = Lambda_0123456789876543210Sym1 ma0123456789876543210 + 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 ma) mb) a) + 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 @@ -428,7 +428,7 @@ Singletons/T184.hs:(0,0)-(0,0): Splicing declarations (_ :: Sing x) -> (applySing ((applySing ((singFun2 @(>>=@#@$)) (%>>=))) sYs)) ((singFun1 - @(Apply (Apply (Apply Lambda_0123456789876543210Sym0 xs) ys) x)) + @(Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) xs) ys)) (\ sY -> case sY of { (_ :: Sing y) @@ -458,7 +458,7 @@ Singletons/T184.hs:(0,0)-(0,0): Splicing declarations -> case sArg_0123456789876543210 of { (_ :: Sing arg_0123456789876543210) -> (id - @(Sing (Case_0123456789876543210 xs ys arg_0123456789876543210 arg_0123456789876543210))) + @(Sing (Case_0123456789876543210 arg_0123456789876543210 xs ys arg_0123456789876543210))) (case sArg_0123456789876543210 of { STuple2 (sX :: Sing x) (sY :: Sing y) -> (applySing ((singFun1 @ReturnSym0) sReturn)) @@ -472,7 +472,7 @@ Singletons/T184.hs:(0,0)-(0,0): Splicing declarations (_ :: Sing a) -> (applySing ((applySing ((singFun2 @(>>=@#@$)) (%>>=))) sMb)) ((singFun1 - @(Apply (Apply (Apply Lambda_0123456789876543210Sym0 ma) mb) a)) + @(Apply (Apply (Apply Lambda_0123456789876543210Sym0 a) ma) mb)) (\ sB -> case sB of { (_ :: Sing b) diff --git a/tests/compile-and-dump/Singletons/T197b.ghc86.template b/tests/compile-and-dump/Singletons/T197b.ghc86.template index 05f63efc..564120ae 100644 --- a/tests/compile-and-dump/Singletons/T197b.ghc86.template +++ b/tests/compile-and-dump/Singletons/T197b.ghc86.template @@ -54,8 +54,8 @@ Singletons/T197b.hs:(0,0)-(0,0): Splicing declarations MkPairSym0 t0123456789876543210 type instance Apply MkPairSym0 t0123456789876543210 = MkPairSym1 t0123456789876543210 infixr 9 `MkPairSym0` - infixr 9 `SPair` infixr 9 `SMkPair` + infixr 9 `SPair` data instance Sing :: (:*:) a b -> GHC.Types.Type where (:%*:) :: forall a b (n :: a) (n :: b). diff --git a/tests/compile-and-dump/Singletons/T312.ghc86.template b/tests/compile-and-dump/Singletons/T312.ghc86.template index 36dc699f..4744680a 100644 --- a/tests/compile-and-dump/Singletons/T312.ghc86.template +++ b/tests/compile-and-dump/Singletons/T312.ghc86.template @@ -105,8 +105,8 @@ Singletons/T312.hs:(0,0)-(0,0): Splicing declarations instance SuppressUnusedWarnings (Let0123456789876543210HSym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Let0123456789876543210HSym2KindInference) ()) - data Let0123456789876543210HSym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 :: forall b0123456789876543210 - c0123456789876543210. + data Let0123456789876543210HSym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 :: forall c0123456789876543210 + b0123456789876543210. (~>) c0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210) where Let0123456789876543210HSym2KindInference :: forall a_01234567898765432100123456789876543210 diff --git a/tests/compile-and-dump/Singletons/T353.ghc86.template b/tests/compile-and-dump/Singletons/T353.ghc86.template index 6854f2c3..f8ef8092 100644 --- a/tests/compile-and-dump/Singletons/T353.ghc86.template +++ b/tests/compile-and-dump/Singletons/T353.ghc86.template @@ -64,8 +64,8 @@ Singletons/T353.hs:0:0:: Splicing declarations suppressUnusedWarnings = snd (((,) MkProdSym0KindInference) ()) data MkProdSym0 :: forall k0123456789876543210 (f0123456789876543210 :: k0123456789876543210 -> Type) - (g0123456789876543210 :: k0123456789876543210 -> Type) - (p0123456789876543210 :: k0123456789876543210). + (p0123456789876543210 :: k0123456789876543210) + (g0123456789876543210 :: k0123456789876543210 -> Type). (~>) (f0123456789876543210 p0123456789876543210) ((~>) (g0123456789876543210 p0123456789876543210) (Prod (f0123456789876543210 :: k0123456789876543210 -> Type) (g0123456789876543210 :: k0123456789876543210 -> Type) (p0123456789876543210 :: k0123456789876543210))) diff --git a/tests/compile-and-dump/Singletons/T358.ghc86.template b/tests/compile-and-dump/Singletons/T358.ghc86.template index 370a3e61..42466b27 100644 --- a/tests/compile-and-dump/Singletons/T358.ghc86.template +++ b/tests/compile-and-dump/Singletons/T358.ghc86.template @@ -32,8 +32,8 @@ Singletons/T358.hs:(0,0)-(0,0): Splicing declarations Method2a arg0123456789876543210 instance SuppressUnusedWarnings Method2aSym0 where suppressUnusedWarnings = snd (((,) Method2aSym0KindInference) ()) - data Method2aSym0 :: forall a0123456789876543210 - b0123456789876543210. + data Method2aSym0 :: forall b0123456789876543210 + a0123456789876543210. (~>) b0123456789876543210 a0123456789876543210 where Method2aSym0KindInference :: forall arg0123456789876543210 @@ -44,8 +44,8 @@ Singletons/T358.hs:(0,0)-(0,0): Splicing declarations Method2b arg0123456789876543210 instance SuppressUnusedWarnings Method2bSym0 where suppressUnusedWarnings = snd (((,) Method2bSym0KindInference) ()) - data Method2bSym0 :: forall a0123456789876543210 - b0123456789876543210. + data Method2bSym0 :: forall b0123456789876543210 + a0123456789876543210. (~>) b0123456789876543210 a0123456789876543210 where Method2bSym0KindInference :: forall arg0123456789876543210 @@ -67,8 +67,8 @@ Singletons/T358.hs:(0,0)-(0,0): Splicing declarations instance SuppressUnusedWarnings Method2a_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Method2a_0123456789876543210Sym0KindInference) ()) - data Method2a_0123456789876543210Sym0 :: forall a0123456789876543210 - b0123456789876543210. + data Method2a_0123456789876543210Sym0 :: forall b0123456789876543210 + a0123456789876543210. (~>) b0123456789876543210 [a0123456789876543210] where Method2a_0123456789876543210Sym0KindInference :: forall a0123456789876543210 @@ -82,8 +82,8 @@ Singletons/T358.hs:(0,0)-(0,0): Splicing declarations instance SuppressUnusedWarnings Method2b_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Method2b_0123456789876543210Sym0KindInference) ()) - data Method2b_0123456789876543210Sym0 :: forall a0123456789876543210 - b0123456789876543210. + data Method2b_0123456789876543210Sym0 :: forall b0123456789876543210 + a0123456789876543210. (~>) b0123456789876543210 [a0123456789876543210] where Method2b_0123456789876543210Sym0KindInference :: forall a0123456789876543210 diff --git a/tests/compile-and-dump/Singletons/T367.ghc86.template b/tests/compile-and-dump/Singletons/T367.ghc86.template new file mode 100644 index 00000000..91643beb --- /dev/null +++ b/tests/compile-and-dump/Singletons/T367.ghc86.template @@ -0,0 +1,39 @@ +Singletons/T367.hs:(0,0)-(0,0): Splicing declarations + singletonsOnly + [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' a0123456789876543210 a0123456789876543210 + instance Data.Singletons.SuppressUnusedWarnings.SuppressUnusedWarnings Const'Sym0 where + Data.Singletons.SuppressUnusedWarnings.suppressUnusedWarnings + = snd (((,) Const'Sym0KindInference) ()) + data Const'Sym0 :: forall a0123456789876543210 + b0123456789876543210. + (~>) a0123456789876543210 ((~>) b0123456789876543210 a0123456789876543210) + where + Const'Sym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply Const'Sym0 arg) (Const'Sym1 arg) => + Const'Sym0 a0123456789876543210 + type instance Apply Const'Sym0 a0123456789876543210 = Const'Sym1 a0123456789876543210 + type family Const' (a :: a) (a :: b) :: a where + Const' x _ = x + sConst' :: + forall a b (t :: a) (t :: b). + Sing t -> Sing t -> Sing (Apply (Apply Const'Sym0 t) t :: a) + sConst' (sX :: Sing x) _ = sX + instance SingI (Const'Sym0 :: (~>) a ((~>) b a)) where + sing = (singFun2 @Const'Sym0) sConst' + instance SingI d => SingI (Const'Sym1 (d :: a) :: (~>) b a) where + sing = (singFun1 @(Const'Sym1 (d :: a))) (sConst' (sing @d)) diff --git a/tests/compile-and-dump/Singletons/T367.hs b/tests/compile-and-dump/Singletons/T367.hs new file mode 100644 index 00000000..c9ade4f7 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T367.hs @@ -0,0 +1,12 @@ +module T367 where + +import Data.Singletons.Prelude +import Data.Singletons.TH (singletonsOnly) + +$(singletonsOnly [d| + const' :: a -> b -> a + const' x _ = x + |]) + +test :: Sing True +test = sConst' @Bool @() STrue STuple0 diff --git a/tests/compile-and-dump/Singletons/TopLevelPatterns.ghc86.template b/tests/compile-and-dump/Singletons/TopLevelPatterns.ghc86.template index bcb248e5..4d9dfa5a 100644 --- a/tests/compile-and-dump/Singletons/TopLevelPatterns.ghc86.template +++ b/tests/compile-and-dump/Singletons/TopLevelPatterns.ghc86.template @@ -103,28 +103,76 @@ Singletons/TopLevelPatterns.hs:(0,0)-(0,0): Splicing declarations l :: Bool m :: Bool [l, m] = [not True, id False] - type family Case_0123456789876543210 a_0123456789876543210 t where - Case_0123456789876543210 a_0123456789876543210 '[y_0123456789876543210, - _] = y_0123456789876543210 - type family Case_0123456789876543210 a_0123456789876543210 t where - Case_0123456789876543210 a_0123456789876543210 '[_, - y_0123456789876543210] = y_0123456789876543210 - type family Case_0123456789876543210 a_0123456789876543210 t where - Case_0123456789876543210 a_0123456789876543210 '(y_0123456789876543210, - _) = y_0123456789876543210 - type family Case_0123456789876543210 a_0123456789876543210 t where - Case_0123456789876543210 a_0123456789876543210 '(_, - y_0123456789876543210) = y_0123456789876543210 - type family Case_0123456789876543210 t where - Case_0123456789876543210 ( 'Bar y_0123456789876543210 _) = y_0123456789876543210 type family Case_0123456789876543210 t where - Case_0123456789876543210 ( 'Bar _ y_0123456789876543210) = y_0123456789876543210 + Case_0123456789876543210 '[_, + y_0123456789876543210] = y_0123456789876543210 type family Case_0123456789876543210 t where Case_0123456789876543210 '[y_0123456789876543210, _] = y_0123456789876543210 type family Case_0123456789876543210 t where - Case_0123456789876543210 '[_, - y_0123456789876543210] = y_0123456789876543210 + Case_0123456789876543210 ( 'Bar _ y_0123456789876543210) = y_0123456789876543210 + type family Case_0123456789876543210 t where + Case_0123456789876543210 ( 'Bar y_0123456789876543210 _) = y_0123456789876543210 + type family Case_0123456789876543210 a_0123456789876543210 t where + Case_0123456789876543210 a_0123456789876543210 '(_, + y_0123456789876543210) = y_0123456789876543210 + type family Case_0123456789876543210 a_0123456789876543210 t where + Case_0123456789876543210 a_0123456789876543210 '(y_0123456789876543210, + _) = y_0123456789876543210 + type family Case_0123456789876543210 a_0123456789876543210 t where + Case_0123456789876543210 a_0123456789876543210 '[_, + y_0123456789876543210] = y_0123456789876543210 + type family Case_0123456789876543210 a_0123456789876543210 t where + Case_0123456789876543210 a_0123456789876543210 '[y_0123456789876543210, + _] = y_0123456789876543210 + type MSym0 = M + type LSym0 = L + type X_0123456789876543210Sym0 = X_0123456789876543210 + 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) ()) + data ISym0 :: (~>) Bool Bool + where + ISym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply ISym0 arg) (ISym1 arg) => + ISym0 a0123456789876543210 + type instance Apply ISym0 a0123456789876543210 = I a0123456789876543210 + type HSym1 (a0123456789876543210 :: Bool) = H a0123456789876543210 + instance SuppressUnusedWarnings HSym0 where + suppressUnusedWarnings + = Data.Tuple.snd (((,) HSym0KindInference) ()) + data HSym0 :: (~>) Bool Bool + where + HSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply HSym0 arg) (HSym1 arg) => + HSym0 a0123456789876543210 + type instance Apply HSym0 a0123456789876543210 = H a0123456789876543210 + type X_0123456789876543210Sym0 = X_0123456789876543210 + type GSym1 (a0123456789876543210 :: Bool) = G a0123456789876543210 + instance SuppressUnusedWarnings GSym0 where + suppressUnusedWarnings + = Data.Tuple.snd (((,) GSym0KindInference) ()) + data GSym0 :: (~>) Bool Bool + where + GSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply GSym0 arg) (GSym1 arg) => + GSym0 a0123456789876543210 + type instance Apply GSym0 a0123456789876543210 = G a0123456789876543210 + type FSym1 (a0123456789876543210 :: Bool) = F a0123456789876543210 + instance SuppressUnusedWarnings FSym0 where + suppressUnusedWarnings + = Data.Tuple.snd (((,) FSym0KindInference) ()) + data FSym0 :: (~>) Bool Bool + where + FSym0KindInference :: forall a0123456789876543210 + arg. SameKind (Apply FSym0 arg) (FSym1 arg) => + FSym0 a0123456789876543210 + type instance Apply FSym0 a0123456789876543210 = F a0123456789876543210 + type X_0123456789876543210Sym0 = X_0123456789876543210 type False_Sym0 = False_ type NotSym1 (a0123456789876543210 :: Bool) = Not a0123456789876543210 @@ -149,55 +197,31 @@ Singletons/TopLevelPatterns.hs:(0,0)-(0,0): Splicing declarations arg. SameKind (Apply IdSym0 arg) (IdSym1 arg) => IdSym0 a0123456789876543210 type instance Apply IdSym0 a0123456789876543210 = Id a0123456789876543210 - type FSym1 (a0123456789876543210 :: Bool) = F a0123456789876543210 - instance SuppressUnusedWarnings FSym0 where - suppressUnusedWarnings - = Data.Tuple.snd (((,) FSym0KindInference) ()) - data FSym0 :: (~>) Bool Bool - where - FSym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply FSym0 arg) (FSym1 arg) => - FSym0 a0123456789876543210 - type instance Apply FSym0 a0123456789876543210 = F a0123456789876543210 - type GSym1 (a0123456789876543210 :: Bool) = G a0123456789876543210 - instance SuppressUnusedWarnings GSym0 where - suppressUnusedWarnings - = Data.Tuple.snd (((,) GSym0KindInference) ()) - data GSym0 :: (~>) Bool Bool - where - GSym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply GSym0 arg) (GSym1 arg) => - GSym0 a0123456789876543210 - type instance Apply GSym0 a0123456789876543210 = G a0123456789876543210 - type HSym1 (a0123456789876543210 :: Bool) = H a0123456789876543210 - instance SuppressUnusedWarnings HSym0 where - suppressUnusedWarnings - = Data.Tuple.snd (((,) HSym0KindInference) ()) - data HSym0 :: (~>) Bool Bool - where - HSym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply HSym0 arg) (HSym1 arg) => - HSym0 a0123456789876543210 - type instance Apply HSym0 a0123456789876543210 = H a0123456789876543210 - type ISym1 (a0123456789876543210 :: Bool) = I a0123456789876543210 - instance SuppressUnusedWarnings ISym0 where - suppressUnusedWarnings - = Data.Tuple.snd (((,) ISym0KindInference) ()) - data ISym0 :: (~>) Bool Bool - where - ISym0KindInference :: forall a0123456789876543210 - arg. SameKind (Apply ISym0 arg) (ISym1 arg) => - ISym0 a0123456789876543210 - type instance Apply ISym0 a0123456789876543210 = I a0123456789876543210 - type JSym0 = J - type KSym0 = K - type LSym0 = L - type MSym0 = M type OtherwiseSym0 = Otherwise - type X_0123456789876543210Sym0 = X_0123456789876543210 - type X_0123456789876543210Sym0 = X_0123456789876543210 - type X_0123456789876543210Sym0 = X_0123456789876543210 - type X_0123456789876543210Sym0 = X_0123456789876543210 + type family M :: Bool where + M = Case_0123456789876543210 X_0123456789876543210Sym0 + type family L :: Bool where + L = Case_0123456789876543210 X_0123456789876543210Sym0 + type family X_0123456789876543210 where + X_0123456789876543210 = Apply (Apply (:@#@$) (Apply NotSym0 TrueSym0)) (Apply (Apply (:@#@$) (Apply IdSym0 FalseSym0)) '[]) + type family K :: Bool where + K = Case_0123456789876543210 X_0123456789876543210Sym0 + type family J :: Bool where + J = Case_0123456789876543210 X_0123456789876543210Sym0 + type family X_0123456789876543210 where + X_0123456789876543210 = Apply (Apply BarSym0 TrueSym0) (Apply HSym0 FalseSym0) + type family I (a :: Bool) :: Bool where + I a_0123456789876543210 = Apply (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0) a_0123456789876543210 + type family H (a :: Bool) :: Bool where + H a_0123456789876543210 = Apply (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0) a_0123456789876543210 + type family X_0123456789876543210 where + X_0123456789876543210 = Apply (Apply Tuple2Sym0 FSym0) GSym0 + type family G (a :: Bool) :: Bool where + G a_0123456789876543210 = Apply (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0) a_0123456789876543210 + type family F (a :: Bool) :: Bool where + F a_0123456789876543210 = Apply (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0) a_0123456789876543210 + type family X_0123456789876543210 where + X_0123456789876543210 = Apply (Apply (:@#@$) NotSym0) (Apply (Apply (:@#@$) IdSym0) '[]) type family False_ where False_ = FalseSym0 type family Not (a :: Bool) :: Bool where @@ -205,114 +229,101 @@ Singletons/TopLevelPatterns.hs:(0,0)-(0,0): Splicing declarations Not 'False = TrueSym0 type family Id (a :: a) :: a where Id x = x - type family F (a :: Bool) :: Bool where - F a_0123456789876543210 = Apply (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0) a_0123456789876543210 - type family G (a :: Bool) :: Bool where - G a_0123456789876543210 = Apply (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0) a_0123456789876543210 - type family H (a :: Bool) :: Bool where - H a_0123456789876543210 = Apply (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0) a_0123456789876543210 - type family I (a :: Bool) :: Bool where - I a_0123456789876543210 = Apply (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0) a_0123456789876543210 - type family J :: Bool where - J = Case_0123456789876543210 X_0123456789876543210Sym0 - type family K :: Bool where - K = Case_0123456789876543210 X_0123456789876543210Sym0 - type family L :: Bool where - L = Case_0123456789876543210 X_0123456789876543210Sym0 - type family M :: Bool where - M = Case_0123456789876543210 X_0123456789876543210Sym0 type family Otherwise :: Bool where Otherwise = TrueSym0 - type family X_0123456789876543210 where - X_0123456789876543210 = Apply (Apply (:@#@$) NotSym0) (Apply (Apply (:@#@$) IdSym0) '[]) - type family X_0123456789876543210 where - X_0123456789876543210 = Apply (Apply Tuple2Sym0 FSym0) GSym0 - type family X_0123456789876543210 where - X_0123456789876543210 = Apply (Apply BarSym0 TrueSym0) (Apply HSym0 FalseSym0) - type family X_0123456789876543210 where - X_0123456789876543210 = Apply (Apply (:@#@$) (Apply NotSym0 TrueSym0)) (Apply (Apply (:@#@$) (Apply IdSym0 FalseSym0)) '[]) - sFalse_ :: Sing False_Sym0 - sNot :: - forall (t :: Bool). Sing t -> Sing (Apply NotSym0 t :: Bool) - sId :: forall a (t :: a). Sing t -> Sing (Apply IdSym0 t :: a) - sF :: forall (t :: Bool). Sing t -> Sing (Apply FSym0 t :: Bool) - sG :: forall (t :: Bool). Sing t -> Sing (Apply GSym0 t :: Bool) - sH :: forall (t :: Bool). Sing t -> Sing (Apply HSym0 t :: Bool) - sI :: forall (t :: Bool). Sing t -> Sing (Apply ISym0 t :: Bool) - sJ :: Sing (JSym0 :: Bool) - sK :: Sing (KSym0 :: Bool) - sL :: Sing (LSym0 :: Bool) sM :: Sing (MSym0 :: Bool) - sOtherwise :: Sing (OtherwiseSym0 :: Bool) + sL :: Sing (LSym0 :: Bool) sX_0123456789876543210 :: Sing X_0123456789876543210Sym0 + sK :: Sing (KSym0 :: Bool) + sJ :: Sing (JSym0 :: Bool) sX_0123456789876543210 :: Sing X_0123456789876543210Sym0 + sI :: forall (t :: Bool). Sing t -> Sing (Apply ISym0 t :: Bool) + sH :: forall (t :: Bool). Sing t -> Sing (Apply HSym0 t :: Bool) sX_0123456789876543210 :: Sing X_0123456789876543210Sym0 + sG :: forall (t :: Bool). Sing t -> Sing (Apply GSym0 t :: Bool) + sF :: forall (t :: Bool). Sing t -> Sing (Apply FSym0 t :: Bool) sX_0123456789876543210 :: Sing X_0123456789876543210Sym0 - sFalse_ = SFalse - sNot STrue = SFalse - sNot SFalse = STrue - sId (sX :: Sing x) = sX - sF (sA_0123456789876543210 :: Sing a_0123456789876543210) + sFalse_ :: Sing False_Sym0 + sNot :: + forall (t :: Bool). Sing t -> Sing (Apply NotSym0 t :: Bool) + sId :: forall a (t :: a). Sing t -> Sing (Apply IdSym0 t :: a) + sOtherwise :: Sing (OtherwiseSym0 :: Bool) + sM + = (GHC.Base.id + @(Sing (Case_0123456789876543210 X_0123456789876543210Sym0 :: Bool))) + (case sX_0123456789876543210 of { + SCons _ + (SCons (sY_0123456789876543210 :: Sing y_0123456789876543210) SNil) + -> sY_0123456789876543210 }) + sL + = (GHC.Base.id + @(Sing (Case_0123456789876543210 X_0123456789876543210Sym0 :: Bool))) + (case sX_0123456789876543210 of { + SCons (sY_0123456789876543210 :: Sing y_0123456789876543210) + (SCons _ SNil) + -> sY_0123456789876543210 }) + sX_0123456789876543210 + = (applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing ((singFun1 @NotSym0) sNot)) STrue))) + ((applySing + ((applySing ((singFun2 @(:@#@$)) SCons)) + ((applySing ((singFun1 @IdSym0) sId)) SFalse))) + SNil) + sK + = (GHC.Base.id + @(Sing (Case_0123456789876543210 X_0123456789876543210Sym0 :: Bool))) + (case sX_0123456789876543210 of { + SBar _ (sY_0123456789876543210 :: Sing y_0123456789876543210) + -> sY_0123456789876543210 }) + sJ + = (GHC.Base.id + @(Sing (Case_0123456789876543210 X_0123456789876543210Sym0 :: Bool))) + (case sX_0123456789876543210 of { + SBar (sY_0123456789876543210 :: Sing y_0123456789876543210) _ + -> sY_0123456789876543210 }) + sX_0123456789876543210 + = (applySing ((applySing ((singFun2 @BarSym0) SBar)) STrue)) + ((applySing ((singFun1 @HSym0) sH)) SFalse) + sI (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((GHC.Base.id @(Sing (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0))) (case sX_0123456789876543210 of { - SCons (sY_0123456789876543210 :: Sing y_0123456789876543210) - (SCons _ SNil) + STuple2 _ (sY_0123456789876543210 :: Sing y_0123456789876543210) -> sY_0123456789876543210 }))) sA_0123456789876543210 - sG (sA_0123456789876543210 :: Sing a_0123456789876543210) + sH (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((GHC.Base.id @(Sing (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0))) (case sX_0123456789876543210 of { - SCons _ - (SCons (sY_0123456789876543210 :: Sing y_0123456789876543210) SNil) + STuple2 (sY_0123456789876543210 :: Sing y_0123456789876543210) _ -> sY_0123456789876543210 }))) sA_0123456789876543210 - sH (sA_0123456789876543210 :: Sing a_0123456789876543210) + sX_0123456789876543210 + = (applySing + ((applySing ((singFun2 @Tuple2Sym0) STuple2)) + ((singFun1 @FSym0) sF))) + ((singFun1 @GSym0) sG) + sG (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((GHC.Base.id @(Sing (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0))) (case sX_0123456789876543210 of { - STuple2 (sY_0123456789876543210 :: Sing y_0123456789876543210) _ + SCons _ + (SCons (sY_0123456789876543210 :: Sing y_0123456789876543210) SNil) -> sY_0123456789876543210 }))) sA_0123456789876543210 - sI (sA_0123456789876543210 :: Sing a_0123456789876543210) + sF (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((GHC.Base.id @(Sing (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0))) (case sX_0123456789876543210 of { - STuple2 _ (sY_0123456789876543210 :: Sing y_0123456789876543210) + SCons (sY_0123456789876543210 :: Sing y_0123456789876543210) + (SCons _ SNil) -> sY_0123456789876543210 }))) sA_0123456789876543210 - sJ - = (GHC.Base.id - @(Sing (Case_0123456789876543210 X_0123456789876543210Sym0 :: Bool))) - (case sX_0123456789876543210 of { - SBar (sY_0123456789876543210 :: Sing y_0123456789876543210) _ - -> sY_0123456789876543210 }) - sK - = (GHC.Base.id - @(Sing (Case_0123456789876543210 X_0123456789876543210Sym0 :: Bool))) - (case sX_0123456789876543210 of { - SBar _ (sY_0123456789876543210 :: Sing y_0123456789876543210) - -> sY_0123456789876543210 }) - sL - = (GHC.Base.id - @(Sing (Case_0123456789876543210 X_0123456789876543210Sym0 :: Bool))) - (case sX_0123456789876543210 of { - SCons (sY_0123456789876543210 :: Sing y_0123456789876543210) - (SCons _ SNil) - -> sY_0123456789876543210 }) - sM - = (GHC.Base.id - @(Sing (Case_0123456789876543210 X_0123456789876543210Sym0 :: Bool))) - (case sX_0123456789876543210 of { - SCons _ - (SCons (sY_0123456789876543210 :: Sing y_0123456789876543210) SNil) - -> sY_0123456789876543210 }) - sOtherwise = STrue sX_0123456789876543210 = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) @@ -320,31 +331,20 @@ Singletons/TopLevelPatterns.hs:(0,0)-(0,0): Splicing declarations ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((singFun1 @IdSym0) sId))) SNil) - sX_0123456789876543210 - = (applySing - ((applySing ((singFun2 @Tuple2Sym0) STuple2)) - ((singFun1 @FSym0) sF))) - ((singFun1 @GSym0) sG) - sX_0123456789876543210 - = (applySing ((applySing ((singFun2 @BarSym0) SBar)) STrue)) - ((applySing ((singFun1 @HSym0) sH)) SFalse) - sX_0123456789876543210 - = (applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((applySing ((singFun1 @NotSym0) sNot)) STrue))) - ((applySing - ((applySing ((singFun2 @(:@#@$)) SCons)) - ((applySing ((singFun1 @IdSym0) sId)) SFalse))) - SNil) + sFalse_ = SFalse + sNot STrue = SFalse + sNot SFalse = STrue + sId (sX :: Sing x) = sX + sOtherwise = STrue + instance SingI (ISym0 :: (~>) Bool Bool) where + sing = (singFun1 @ISym0) sI + instance SingI (HSym0 :: (~>) Bool Bool) where + sing = (singFun1 @HSym0) sH + instance SingI (GSym0 :: (~>) Bool Bool) where + sing = (singFun1 @GSym0) sG + instance SingI (FSym0 :: (~>) Bool Bool) where + sing = (singFun1 @FSym0) sF instance SingI (NotSym0 :: (~>) Bool Bool) where sing = (singFun1 @NotSym0) sNot instance SingI (IdSym0 :: (~>) a a) where sing = (singFun1 @IdSym0) sId - instance SingI (FSym0 :: (~>) Bool Bool) where - sing = (singFun1 @FSym0) sF - instance SingI (GSym0 :: (~>) Bool Bool) where - sing = (singFun1 @GSym0) sG - instance SingI (HSym0 :: (~>) Bool Bool) where - sing = (singFun1 @HSym0) sH - instance SingI (ISym0 :: (~>) Bool Bool) where - sing = (singFun1 @ISym0) sI