diff --git a/CHANGES.md b/CHANGES.md --- a/CHANGES.md +++ b/CHANGES.md @@ -1,6 +1,20 @@ Changelog for singletons project ================================ +2.1 +--- +* Require `th-desugar` >= 1.6 + +* Work with GHC 8. GHC 8 gives the opportunity to simplify some pieces of +singletons, but these opportunities are not yet fully realized. For example, +injective type families means that we no longer need `Sing` to be a data +family; it could be a type family. This might drastically simplify the way +functions are singletonized. But not yet! + +* `singletons` now outputs a few more type/kind annotations to help GHC do +type inference. There may be a few more programs accepted than before. +(This is the fix for #136.) + 2.0.1 ----- * Lots more functions in `Data.Singletons.Prelude.List`: diff --git a/singletons.cabal b/singletons.cabal --- a/singletons.cabal +++ b/singletons.cabal @@ -1,5 +1,5 @@ name: singletons -version: 2.0.1 +version: 2.1 -- Remember to bump version in the Makefile as well cabal-version: >= 1.10 synopsis: A framework for generating singleton types @@ -20,6 +20,10 @@ tests/compile-and-dump/InsertionSort/*.ghc710.template, tests/compile-and-dump/Promote/*.ghc710.template, tests/compile-and-dump/Singletons/*.ghc710.template + tests/compile-and-dump/GradingClient/*.ghc80.template, + tests/compile-and-dump/InsertionSort/*.ghc80.template, + tests/compile-and-dump/Promote/*.ghc80.template, + tests/compile-and-dump/Singletons/*.ghc80.template license: BSD3 license-file: LICENSE build-type: Simple @@ -38,7 +42,7 @@ source-repository this type: git location: https://github.com/goldfirere/singletons.git - tag: v2.0.1 + tag: v2.1 library hs-source-dirs: src @@ -46,12 +50,15 @@ mtl >= 2.1.2, template-haskell, containers >= 0.5, - th-desugar >= 1.5.4.1 && < 1.6, + th-desugar >= 1.6 && < 1.7, syb >= 0.4 default-language: Haskell2010 other-extensions: TemplateHaskell -- TemplateHaskell must be listed in cabal file to work with -- ghc7.8 + if impl(ghc >= 7.11) + ghc-options: -Wno-redundant-constraints + exposed-modules: Data.Singletons, Data.Singletons.CustomStar, Data.Singletons.TypeRepStar, diff --git a/src/Data/Singletons/CustomStar.hs b/src/Data/Singletons/CustomStar.hs --- a/src/Data/Singletons/CustomStar.hs +++ b/src/Data/Singletons/CustomStar.hs @@ -72,9 +72,10 @@ kinds <- mapM getKind names ctors <- zipWithM (mkCtor True) names kinds let repDecl = DDataD Data [] repName [] ctors - [''Eq, ''Show, ''Read] + [DConPr ''Eq, DConPr ''Show, DConPr ''Read] fakeCtors <- zipWithM (mkCtor False) names kinds - let dataDecl = DataDecl Data repName [] fakeCtors [''Show, ''Read , ''Eq] + let dataDecl = DataDecl Data repName [] fakeCtors + [DConPr ''Show, DConPr ''Read , DConPr ''Eq] ordInst <- mkOrdInstance (DConT repName) fakeCtors (pOrdInst, promDecls) <- promoteM [] $ do promoteDataDec dataDecl promoteInstanceDec mempty ordInst @@ -93,31 +94,40 @@ DTyConI (DDataD _ (_:_) _ _ _ _) _ -> fail "Cannot make a representation of a constrainted data type" DTyConI (DDataD _ [] _ tvbs _ _) _ -> - return $ map (fromMaybe DStarK . extractTvbKind) tvbs + return $ map (fromMaybe DStarT . extractTvbKind) tvbs DTyConI (DTySynD _ tvbs _) _ -> - return $ map (fromMaybe DStarK . extractTvbKind) tvbs + return $ map (fromMaybe DStarT . extractTvbKind) tvbs DPrimTyConI _ n _ -> - return $ replicate n DStarK + return $ replicate n DStarT _ -> fail $ "Invalid thing for representation: " ++ (show name) -- first parameter is whether this is a real ctor (with a fresh name) -- or a fake ctor (when the name is actually a Haskell type) mkCtor :: DsMonad q => Bool -> Name -> [DKind] -> q DCon mkCtor real name args = do - (types, vars) <- evalForPair $ mapM kindToType args + (types, vars) <- evalForPair $ mapM (kindToType []) args dataName <- if real then mkDataName (nameBase name) else return name - return $ DCon (map DPlainTV vars) [] dataName $ - DNormalC (map (\ty -> (NotStrict, ty)) types) + return $ DCon (map DPlainTV vars) [] dataName + (DNormalC (map (\ty -> (noBang, ty)) types)) + Nothing + where + noBang = Bang NoSourceUnpackedness NoSourceStrictness -- demote a kind back to a type, accumulating any unbound parameters - kindToType :: DsMonad q => DKind -> QWithAux [Name] q DType - kindToType (DForallK _ _) = fail "Explicit forall encountered in kind" - kindToType (DVarK n) = do + kindToType :: DsMonad q => [DType] -> DKind -> QWithAux [Name] q DType + kindToType _ (DForallT _ _ _) = fail "Explicit forall encountered in kind" + kindToType args (DAppT f a) = do + a' <- kindToType [] a + kindToType (a' : args) f + kindToType args (DSigT t k) = do + t' <- kindToType [] t + k' <- kindToType [] k + return $ DSigT t' k' `foldType` args + kindToType args (DVarT n) = do addElement n - return $ DVarT n - kindToType (DConK n args) = foldType (DConT n) <$> mapM kindToType args - kindToType (DArrowK k1 k2) = do - t1 <- kindToType k1 - t2 <- kindToType k2 - return $ DAppT (DAppT DArrowT t1) t2 - kindToType DStarK = return $ DConT repName + return $ DVarT n `foldType` args + kindToType args (DConT n) = return $ DConT n `foldType` args + kindToType args DArrowT = return $ DArrowT `foldType` args + kindToType args k@(DLitT {}) = return $ k `foldType` args + kindToType args DWildCardT = return $ DWildCardT `foldType` args + kindToType args DStarT = return $ DConT repName `foldType` args diff --git a/src/Data/Singletons/Deriving/Bounded.hs b/src/Data/Singletons/Deriving/Bounded.hs --- a/src/Data/Singletons/Deriving/Bounded.hs +++ b/src/Data/Singletons/Deriving/Bounded.hs @@ -31,14 +31,14 @@ -- of Haskell 2010 Language Report. -- Note that order of conditions below is important. when (null cons - || (any (\(DCon _ _ _ f) -> not . null . tysOfConFields $ f) cons + || (any (\(DCon _ _ _ f _) -> not . null . tysOfConFields $ f) cons && (not . null . tail $ cons))) $ fail ("Can't derive Bounded instance for " ++ pprint (typeToTH ty) ++ ".") -- at this point we know that either we have a datatype that has only one -- constructor or a datatype where each constructor is nullary - let (DCon _ _ minName fields) = head cons - (DCon _ _ maxName _) = last cons + let (DCon _ _ minName fields _) = head cons + (DCon _ _ maxName _ _) = last cons fieldsCount = length $ tysOfConFields fields (minRHS, maxRHS) = case fieldsCount of 0 -> (DConE minName, DConE maxName) diff --git a/src/Data/Singletons/Deriving/Enum.hs b/src/Data/Singletons/Deriving/Enum.hs --- a/src/Data/Singletons/Deriving/Enum.hs +++ b/src/Data/Singletons/Deriving/Enum.hs @@ -20,19 +20,21 @@ import Data.Singletons.Util import Data.Singletons.Names import Control.Monad +import Data.Maybe -- monadic for failure only mkEnumInstance :: Quasi q => DType -> [DCon] -> q UInstDecl mkEnumInstance ty cons = do when (null cons || - any (\(DCon tvbs cxt _ f) -> or [ not $ null $ tysOfConFields f - , not $ null tvbs - , not $ null cxt ]) cons) $ + any (\(DCon tvbs cxt _ f rty) -> or [ not $ null $ tysOfConFields f + , not $ null tvbs + , not $ null cxt + , isJust rty ]) cons) $ fail ("Can't derive Enum instance for " ++ pprint (typeToTH ty) ++ ".") n <- qNewName "n" let to_enum = UFunction [DClause [DVarPa n] (to_enum_rhs cons [0..])] to_enum_rhs [] _ = DVarE errorName `DAppE` DLitE (StringL "toEnum: bad argument") - to_enum_rhs (DCon _ _ name _ : rest) (num:nums) = + to_enum_rhs (DCon _ _ name _ _ : rest) (num:nums) = DCaseE (DVarE equalsName `DAppE` DVarE n `DAppE` DLitE (IntegerL num)) [ DMatch (DConPa trueName []) (DConE name) , DMatch (DConPa falseName []) (to_enum_rhs rest nums) ] diff --git a/src/Data/Singletons/Deriving/Infer.hs b/src/Data/Singletons/Deriving/Infer.hs --- a/src/Data/Singletons/Deriving/Infer.hs +++ b/src/Data/Singletons/Deriving/Infer.hs @@ -21,4 +21,4 @@ inferConstraints :: DPred -> [DCon] -> DCxt inferConstraints pr = nubBy geq . concatMap infer_ct where - infer_ct (DCon _ _ _ fields) = map (pr `DAppPr`) (tysOfConFields fields) + infer_ct (DCon _ _ _ fields _) = map (pr `DAppPr`) (tysOfConFields fields) diff --git a/src/Data/Singletons/Deriving/Ord.hs b/src/Data/Singletons/Deriving/Ord.hs --- a/src/Data/Singletons/Deriving/Ord.hs +++ b/src/Data/Singletons/Deriving/Ord.hs @@ -39,7 +39,7 @@ compare_noneq_clauses) )] }) mk_equal_clause :: Quasi q => DCon -> q DClause -mk_equal_clause (DCon _tvbs _cxt name fields) = do +mk_equal_clause (DCon _tvbs _cxt name fields _rty) = do let tys = tysOfConFields fields a_names <- mapM (const $ newUniqueName "a") tys b_names <- mapM (const $ newUniqueName "b") tys @@ -54,8 +54,8 @@ a_names b_names)) mk_nonequal_clause :: (DCon, Int) -> (DCon, Int) -> DClause -mk_nonequal_clause (DCon _tvbs1 _cxt1 name1 fields1, n1) - (DCon _tvbs2 _cxt2 name2 fields2, n2) = +mk_nonequal_clause (DCon _tvbs1 _cxt1 name1 fields1 _rty1, n1) + (DCon _tvbs2 _cxt2 name2 fields2 _rty2, n2) = DClause [pat1, pat2] (case n1 `compare` n2 of LT -> DConE cmpLTName EQ -> DConE cmpEQName diff --git a/src/Data/Singletons/Names.hs b/src/Data/Singletons/Names.hs --- a/src/Data/Singletons/Names.hs +++ b/src/Data/Singletons/Names.hs @@ -190,7 +190,7 @@ trueTySym = promoteValRhs trueName boolKi :: DKind -boolKi = DConK boolName [] +boolKi = DConT boolName andTySym :: DType andTySym = promoteValRhs andName @@ -223,7 +223,7 @@ | otherwise = (prefixLCName "s" "%") $ upcase n kindParam :: DKind -> DType -kindParam k = DSigT (DConT kProxyDataName) (DConK kProxyTypeName [k]) +kindParam k = DSigT (DConT kProxyDataName) (DConT kProxyTypeName `DAppT` k) proxyFor :: DType -> DExp proxyFor ty = DSigE (DConE proxyDataName) (DAppT (DConT proxyTypeName) ty) @@ -259,6 +259,6 @@ -> q ([DTyVarBndr], DCxt) mkKProxies ns = do kproxies <- mapM (const $ qNewName "kproxy") ns - return ( zipWith (\kp kv -> DKindedTV kp (DConK kProxyTypeName [DVarK kv])) + return ( zipWith (\kp kv -> DKindedTV kp (DConT kProxyTypeName `DAppT` DVarT kv)) kproxies ns , map (\kp -> mkEqPred (DVarT kp) (DConT kProxyDataName)) kproxies ) diff --git a/src/Data/Singletons/Partition.hs b/src/Data/Singletons/Partition.hs --- a/src/Data/Singletons/Partition.hs +++ b/src/Data/Singletons/Partition.hs @@ -54,16 +54,16 @@ , pd_instance_decs = derived_instances } where ty = foldType (DConT name) (map tvbToType tvbs) - part_derivings :: Quasi m => Name -> m (Either Name UInstDecl) - part_derivings deriv_name - | deriv_name == ordName - = Right <$> mkOrdInstance ty cons - | deriv_name == boundedName - = Right <$> mkBoundedInstance ty cons - | deriv_name == enumName - = Right <$> mkEnumInstance ty cons - | otherwise - = return (Left deriv_name) + part_derivings :: Quasi m => DPred -> m (Either DPred UInstDecl) + part_derivings deriv = case deriv of + DConPr deriv_name + | deriv_name == ordName + -> Right <$> mkOrdInstance ty cons + | deriv_name == boundedName + -> Right <$> mkBoundedInstance ty cons + | deriv_name == enumName + -> Right <$> mkEnumInstance ty cons + _ -> return (Left deriv) partitionDec (DClassD cxt name tvbs fds decs) = do env <- concatMapM partitionClassDec decs @@ -72,7 +72,7 @@ , cd_tvbs = tvbs , cd_fds = fds , cd_lde = env }] } -partitionDec (DInstanceD cxt ty decs) = do +partitionDec (DInstanceD _ cxt ty decs) = do defns <- liftM catMaybes $ mapM partitionInstanceDec decs (name, tys) <- split_app_tys [] ty return $ mempty { pd_instance_decs = [InstDecl { id_cxt = cxt diff --git a/src/Data/Singletons/Prelude.hs b/src/Data/Singletons/Prelude.hs --- a/src/Data/Singletons/Prelude.hs +++ b/src/Data/Singletons/Prelude.hs @@ -70,7 +70,7 @@ -- *** Scans Scanl, sScanl, Scanl1, sScanl1, Scanr, sScanr, Scanr1, sScanr1, -- ** Searching lists - Elem, sElem, NotElem, sNotElem, + Elem, sElem, NotElem, sNotElem, Lookup, sLookup, -- ** Zipping and unzipping lists Zip, sZip, Zip3, sZip3, ZipWith, sZipWith, ZipWith3, sZipWith3, Unzip, sUnzip, Unzip3, sUnzip3, diff --git a/src/Data/Singletons/Prelude/List.hs b/src/Data/Singletons/Prelude/List.hs --- a/src/Data/Singletons/Prelude/List.hs +++ b/src/Data/Singletons/Prelude/List.hs @@ -1,7 +1,11 @@ {-# LANGUAGE TypeOperators, DataKinds, PolyKinds, TypeFamilies, TemplateHaskell, GADTs, UndecidableInstances, RankNTypes, - ScopedTypeVariables, FlexibleContexts #-} + ScopedTypeVariables, FlexibleContexts, CPP #-} {-# OPTIONS_GHC -O0 #-} +#if __GLASGOW_HASKELL__ >= 711 +{-# LANGUAGE TypeInType #-} +#endif + ----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.Prelude.List @@ -518,7 +522,8 @@ (\\) :: (Eq a) => [a] -> [a] -> [a] (\\) = foldl (flip delete) - infix 5 \\ + infix 5 \\ -- This comment is necessary so CPP doesn't treat the + -- trailing backslash as a line splice. Urgh. deleteBy :: (a -> a -> Bool) -> a -> [a] -> [a] deleteBy _ _ [] = [] diff --git a/src/Data/Singletons/Prelude/Maybe.hs b/src/Data/Singletons/Prelude/Maybe.hs --- a/src/Data/Singletons/Prelude/Maybe.hs +++ b/src/Data/Singletons/Prelude/Maybe.hs @@ -1,6 +1,9 @@ {-# LANGUAGE TemplateHaskell, ScopedTypeVariables, TypeFamilies, DataKinds, PolyKinds, UndecidableInstances, GADTs, - RankNTypes #-} + RankNTypes, CPP #-} +#if __GLASGOW_HASKELL__ >= 711 +{-# LANGUAGE TypeInType #-} +#endif ----------------------------------------------------------------------------- -- | diff --git a/src/Data/Singletons/Prelude/Ord.hs b/src/Data/Singletons/Prelude/Ord.hs --- a/src/Data/Singletons/Prelude/Ord.hs +++ b/src/Data/Singletons/Prelude/Ord.hs @@ -1,6 +1,9 @@ {-# LANGUAGE TemplateHaskell, DataKinds, PolyKinds, ScopedTypeVariables, TypeFamilies, TypeOperators, GADTs, UndecidableInstances, - FlexibleContexts, DefaultSignatures, InstanceSigs #-} + FlexibleContexts, DefaultSignatures, InstanceSigs, CPP #-} +#if __GLASGOW_HASKELL__ >= 711 +{-# LANGUAGE TypeInType #-} +#endif ----------------------------------------------------------------------------- -- | @@ -40,8 +43,11 @@ import Data.Singletons.Single import Data.Singletons.Prelude.Eq import Data.Singletons.Prelude.Instances -import Data.Singletons.Prelude.Bool import Data.Singletons.Util + +#if __GLASGOW_HASKELL__ < 711 +import Data.Singletons ( Sing ) +#endif $(singletonsOnly [d| class (Eq a) => Ord a where diff --git a/src/Data/Singletons/Prelude/Tuple.hs b/src/Data/Singletons/Prelude/Tuple.hs --- a/src/Data/Singletons/Prelude/Tuple.hs +++ b/src/Data/Singletons/Prelude/Tuple.hs @@ -1,5 +1,8 @@ {-# LANGUAGE TemplateHaskell, ScopedTypeVariables, DataKinds, PolyKinds, - RankNTypes, TypeFamilies, GADTs, UndecidableInstances #-} + RankNTypes, TypeFamilies, GADTs, UndecidableInstances, CPP #-} +#if __GLASGOW_HASKELL__ >= 711 +{-# LANGUAGE TypeInType #-} +#endif ----------------------------------------------------------------------------- -- | diff --git a/src/Data/Singletons/Promote.hs b/src/Data/Singletons/Promote.hs --- a/src/Data/Singletons/Promote.hs +++ b/src/Data/Singletons/Promote.hs @@ -99,7 +99,7 @@ promoteEqInstance :: DsMonad q => Name -> q [Dec] promoteEqInstance name = do (_tvbs, cons) <- getDataD "I cannot make an instance of (:==) for it." name - cons' <- mapM dsCon cons + cons' <- concatMapM dsCon cons vars <- replicateM (length _tvbs) (qNewName "k") kind <- promoteType (foldType (DConT name) (map DVarT vars)) inst_decs <- mkEqTypeInstance kind cons' @@ -110,7 +110,7 @@ promoteInstance mk_inst class_name name = do (tvbs, cons) <- getDataD ("I cannot make an instance of " ++ class_name ++ " for it.") name - cons' <- mapM dsCon cons + cons' <- concatMapM dsCon cons tvbs' <- mapM dsTvb tvbs raw_inst <- mk_inst (foldType (DConT name) (map tvbToType tvbs')) cons' decs <- promoteM_ [] $ void $ promoteInstanceDec Map.empty raw_inst @@ -120,7 +120,7 @@ promoteInfo (DTyConI dec _instances) = promoteDecs [dec] promoteInfo (DPrimTyConI _name _numArgs _unlifted) = fail "Promotion of primitive type constructors not supported" -promoteInfo (DVarI _name _ty _mdec _fixity) = +promoteInfo (DVarI _name _ty _mdec) = fail "Promotion of individual values not supported" promoteInfo (DTyVarI _name _ty) = fail "Promotion of individual type variables not supported" @@ -224,7 +224,8 @@ -- deriving Eq instance kvs <- replicateM (length tvbs) (qNewName "k") kind <- promoteType (foldType (DConT name) (map DVarT kvs)) - when (elem eqName derivings) $ do + when (any (\case DConPr n -> n == eqName + _ -> False) derivings) $ do eq_decs <- mkEqTypeInstance kind ctors emitDecs eq_decs @@ -246,12 +247,10 @@ pCxt <- mapM promote_superclass_pred cxt let cxt' = pCxt ++ proxyCxt sig_decs <- mapM (uncurry promote_sig) (Map.toList meth_sigs) - -- the first arg to promoteMethod is a kind subst. We actually don't - -- want to subst for default instances, so we pass Map.empty let defaults_list = Map.toList defaults defaults_names = map fst defaults_list (default_decs, ann_rhss, prom_rhss) - <- mapAndUnzip3M (promoteMethod Map.empty meth_sigs) defaults_list + <- mapAndUnzip3M (promoteMethod Nothing meth_sigs) defaults_list let infix_decls' = catMaybes $ map (uncurry promoteInfixDecl) infix_decls @@ -270,9 +269,10 @@ args <- mapM (const $ qNewName "arg") argKs emitDecsM $ defunctionalize proName (map Just argKs) (Just resK) - return $ DFamilyD TypeFam proName - (zipWith DKindedTV args argKs) - (Just resK) + return $ DOpenTypeFamilyD (DTypeFamilyHead proName + (zipWith DKindedTV args argKs) + (DKindSig resK) + Nothing) promote_superclass_pred :: DPred -> PrM DPred promote_superclass_pred = go @@ -282,6 +282,7 @@ go (DVarPr name) = fail $ "Cannot promote ConstraintKinds variables like " ++ show name go (DConPr name) = return $ DConPr (promoteClassName name) + go DWildCardPr = return DWildCardPr -- returns (unpromoted method name, ALetDecRHS) pairs promoteInstanceDec :: Map Name DType -> UInstDecl -> PrM AInstDecl @@ -292,8 +293,8 @@ cls_tvb_names <- lookup_cls_tvb_names inst_kis <- mapM promoteType inst_tys let subst = Map.fromList $ zip cls_tvb_names inst_kis - (meths', ann_rhss, _) <- mapAndUnzip3M (promoteMethod subst meth_sigs) meths - emitDecs [DInstanceD [] (foldType (DConT pClsName) + (meths', ann_rhss, _) <- mapAndUnzip3M (promoteMethod (Just subst) meth_sigs) meths + emitDecs [DInstanceD Nothing [] (foldType (DConT pClsName) (map kindParam inst_kis)) meths'] return (decl { id_meths = zip (map fst meths) ann_rhss }) where @@ -311,7 +312,7 @@ _ -> fail $ "Cannot find class declaration annotation for " ++ show cls_name extract_kv_name :: DTyVarBndr -> Name - extract_kv_name (DKindedTV _ (DConK _kproxy [DVarK kv_name])) = kv_name + extract_kv_name (DKindedTV _ (DConT _kproxy `DAppT` DVarT kv_name)) = kv_name extract_kv_name tvb = error $ "Internal error: extract_kv_name\n" ++ show tvb -- promoteMethod needs to substitute in a method's kind because GHC does not do @@ -321,29 +322,42 @@ -- this can be rewritten more cleanly, I imagine. -- UPDATE: GHC 7.10.2 didn't fully solve GHC#9063. Urgh. -promoteMethod :: Map Name DKind -- instantiations for class tyvars +promoteMethod :: Maybe (Map Name DKind) + -- ^ instantiations for class tyvars (Nothing for default decls) -> Map Name DType -- method types -> (Name, ULetDecRHS) -> PrM (DDec, ALetDecRHS, DType) -- returns (type instance, ALetDecRHS, promoted RHS) -promoteMethod subst sigs_map (meth_name, meth_rhs) = do - ((_, _, _, eqns), _defuns, ann_rhs) - <- promoteLetDecRHS sigs_map noPrefix meth_name meth_rhs +promoteMethod m_subst sigs_map (meth_name, meth_rhs) = do (arg_kis, res_ki) <- lookup_meth_ty + ((_, _, _, eqns), _defuns, ann_rhs) + <- promoteLetDecRHS (Just (arg_kis, res_ki)) sigs_map noPrefix meth_name meth_rhs meth_arg_tvs <- mapM (const $ qNewName "a") arg_kis - let meth_arg_kis' = map (substKind subst) arg_kis - meth_res_ki' = substKind subst res_ki + let do_subst = maybe id substKind m_subst + meth_arg_kis' = map do_subst arg_kis + meth_res_ki' = do_subst res_ki helperNameBase = case nameBase proName of first:_ | not (isHsLetter first) -> "TFHelper" alpha -> alpha + family_args +#if __GLASGOW_HASKELL__ >= 711 + -- GHC 8 requires bare tyvars to the left of a type family default + | Nothing <- m_subst + = map DVarT meth_arg_tvs + | otherwise +#endif + = zipWith (DSigT . DVarT) meth_arg_tvs meth_arg_kis' helperName <- newUniqueName helperNameBase - emitDecs [DClosedTypeFamilyD helperName - (zipWith DKindedTV meth_arg_tvs meth_arg_kis') - (Just meth_res_ki') eqns] + emitDecs [DClosedTypeFamilyD (DTypeFamilyHead + helperName + (zipWith DKindedTV meth_arg_tvs meth_arg_kis') + (DKindSig meth_res_ki') + Nothing) + eqns] emitDecsM (defunctionalize helperName (map Just meth_arg_kis') (Just meth_res_ki')) return ( DTySynInstD proName - (DTySynEqn (zipWith (DSigT . DVarT) meth_arg_tvs meth_arg_kis') + (DTySynEqn family_args (foldApply (promoteValRhs helperName) (map DVarT meth_arg_tvs))) , ann_rhs , DConT (promoteTySym helperName 0) ) @@ -355,13 +369,14 @@ Nothing -> do mb_info <- dsReify proName case mb_info of - Just (DTyConI (DFamilyD _ _ tvbs mb_res_ki) _) - -> return ( map (default_to_star . extractTvbKind) tvbs - , default_to_star mb_res_ki ) + Just (DTyConI (DOpenTypeFamilyD (DTypeFamilyHead _ tvbs mb_res_ki _)) _) + -> let arg_kis = map (default_to_star . extractTvbKind) tvbs + res_ki = default_to_star (resultSigToMaybeKind mb_res_ki) + in return (arg_kis, res_ki) _ -> fail $ "Cannot find type annotation for " ++ show proName Just ty -> promoteUnraveled ty - default_to_star Nothing = DStarK + default_to_star Nothing = DStarT default_to_star (Just k) = k promoteLetDecEnv :: (String, String) -> ULetDecEnv -> PrM ([DDec], ALetDecEnv) @@ -373,7 +388,7 @@ -- promote all the declarations, producing annotated declarations let (names, rhss) = unzip $ Map.toList value_env (payloads, defun_decss, ann_rhss) - <- fmap unzip3 $ zipWithM (promoteLetDecRHS type_env prefixes) names rhss + <- fmap unzip3 $ zipWithM (promoteLetDecRHS Nothing type_env prefixes) names rhss emitDecs $ concat defun_decss let decs = map payload_to_dec payloads ++ infix_decls' @@ -386,7 +401,11 @@ return (decs, let_dec_env') where - payload_to_dec (name, tvbs, m_ki, eqns) = DClosedTypeFamilyD name tvbs m_ki eqns + payload_to_dec (name, tvbs, m_ki, eqns) = DClosedTypeFamilyD + (DTypeFamilyHead name tvbs sig Nothing) + eqns + where + sig = maybe DNoSig DKindSig m_ki promoteInfixDecl :: Fixity -> Name -> Maybe DDec promoteInfixDecl fixity name @@ -396,20 +415,25 @@ -- This function is used both to promote class method defaults and normal -- let bindings. Thus, it can't quite do all the work locally and returns -- an intermediate structure. Perhaps a better design is available. -promoteLetDecRHS :: Map Name DType -- local type env't +promoteLetDecRHS :: Maybe ([DKind], DKind) -- the promoted type of the RHS (if known) + -- needed to fix #136 + -> Map Name DType -- local type env't -> (String, String) -- let-binding prefixes -> Name -- name of the thing being promoted -> ULetDecRHS -- body of the thing -> PrM ( (Name, [DTyVarBndr], Maybe DKind, [DTySynEqn]) -- "type family" , [DDec] -- defunctionalization , ALetDecRHS ) -- annotated RHS -promoteLetDecRHS type_env prefixes name (UValue exp) = do +promoteLetDecRHS m_rhs_ki type_env prefixes name (UValue exp) = do (res_kind, num_arrows) - <- case Map.lookup name type_env of - Nothing -> return (Nothing, 0) - Just ty -> do - ki <- promoteType ty - return (Just ki, countArgs ty) + <- 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 + -> do ki <- promoteType ty + return (Just ki, countArgs ty) + | otherwise + -> return (Nothing, 0) case num_arrows of 0 -> do all_locals <- allLocals @@ -425,14 +449,15 @@ names <- replicateM num_arrows (newUniqueName "a") let pats = map DVarPa names newArgs = map DVarE names - promoteLetDecRHS type_env prefixes name + promoteLetDecRHS m_rhs_ki type_env prefixes name (UFunction [DClause pats (foldExp exp newArgs)]) -promoteLetDecRHS type_env prefixes name (UFunction clauses) = do +promoteLetDecRHS m_rhs_ki type_env prefixes name (UFunction clauses) = do numArgs <- count_args clauses - (m_argKs, m_resK, ty_num_args) <- case Map.lookup name type_env of - Nothing -> return (replicate numArgs Nothing, Nothing, numArgs) - Just ty -> do + (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 + -> do -- promoteType turns arrows into TyFun. So, we unravel first to -- avoid this behavior. Note the use of ravelTyFun in resultK -- to make the return kind work out @@ -440,6 +465,8 @@ -- invariant: countArgs ty == length argKs return (map Just argKs, Just resultK, length argKs) + | otherwise + -> return (replicate numArgs Nothing, Nothing, numArgs) let proName = promoteValNameLhsPrefix prefixes name all_locals <- allLocals defun_decs <- defunctionalize proName @@ -536,9 +563,11 @@ all_locals <- allLocals let all_args = all_locals ++ tyFamLamTypes tvbs = map DPlainTV all_args - emitDecs [DClosedTypeFamilyD lambdaName - tvbs - Nothing + emitDecs [DClosedTypeFamilyD (DTypeFamilyHead + lambdaName + tvbs + DNoSig + Nothing) [DTySynEqn (map DVarT (all_locals ++ tyNames)) rhs]] emitDecsM $ defunctionalize lambdaName (map (const Nothing) all_args) Nothing @@ -554,7 +583,7 @@ tyvarName <- qNewName "t" let all_args = all_locals ++ [tyvarName] tvbs = map DPlainTV all_args - emitDecs [DClosedTypeFamilyD caseTFName tvbs Nothing eqns] + emitDecs [DClosedTypeFamilyD (DTypeFamilyHead caseTFName tvbs DNoSig Nothing) eqns] -- See Note [Annotate case return type] in Single let applied_case = prom_case `DAppT` exp' return ( applied_case diff --git a/src/Data/Singletons/Promote/Defun.hs b/src/Data/Singletons/Promote/Defun.hs --- a/src/Data/Singletons/Promote/Defun.hs +++ b/src/Data/Singletons/Promote/Defun.hs @@ -23,7 +23,7 @@ defunInfo (DPrimTyConI _name _numArgs _unlifted) = fail $ "Building defunctionalization symbols of primitive " ++ "type constructors not supported" -defunInfo (DVarI _name _ty _mdec _fixity) = +defunInfo (DVarI _name _ty _mdec) = fail "Building defunctionalization symbols of values not supported" defunInfo (DTyVarI _name _ty) = fail "Building defunctionalization symbols of type variables not supported" @@ -31,13 +31,13 @@ buildDefunSyms :: DDec -> PrM [DDec] buildDefunSyms (DDataD _new_or_data _cxt tyName tvbs ctors _derivings) = buildDefunSymsDataD tyName tvbs ctors -buildDefunSyms (DClosedTypeFamilyD name tvbs returnK_maybe _) = do +buildDefunSyms (DClosedTypeFamilyD (DTypeFamilyHead name tvbs result_sig _) _) = do let arg_m_kinds = map extractTvbKind tvbs - defunctionalize name arg_m_kinds returnK_maybe -buildDefunSyms (DFamilyD TypeFam name tvbs returnK_maybe) = do + defunctionalize name arg_m_kinds (resultSigToMaybeKind result_sig) +buildDefunSyms (DOpenTypeFamilyD (DTypeFamilyHead name tvbs result_sig _)) = do let arg_kinds = map (default_to_star . extractTvbKind) tvbs - res_kind = default_to_star returnK_maybe - default_to_star Nothing = Just DStarK + res_kind = default_to_star (resultSigToMaybeKind result_sig) + default_to_star Nothing = Just DStarT default_to_star (Just k) = Just k defunctionalize name arg_kinds res_kind buildDefunSyms (DTySynD name tvbs _type) = do @@ -96,7 +96,8 @@ -- indicate which kinds are known and which need to be inferred. defunctionalize :: Name -> [Maybe DKind] -> Maybe DKind -> PrM [DDec] defunctionalize name m_arg_kinds' m_res_kind' = do - let (m_arg_kinds, m_res_kind) = eta_expand m_arg_kinds' m_res_kind' + let (m_arg_kinds, m_res_kind) = eta_expand (noExactTyVars m_arg_kinds') + (noExactTyVars m_res_kind') num_args = length m_arg_kinds sat_name = promoteTySym name num_args tvbNames <- replicateM num_args $ qNewName "t" @@ -112,17 +113,9 @@ eta_expand :: [Maybe DKind] -> Maybe DKind -> ([Maybe DKind], Maybe DKind) eta_expand m_arg_kinds Nothing = (m_arg_kinds, Nothing) eta_expand m_arg_kinds (Just res_kind) = - let ks = unravelK res_kind - (argKs, [resultK]) = splitAt (length ks - 1) ks + let (_, _, argKs, resultK) = unravel res_kind in (m_arg_kinds ++ (map Just argKs), Just resultK) - unravelK :: DKind -> [DKind] - unravelK (DForallK _name k) = unravelK k - unravelK (DArrowK (DConK _ ks) DStarK) = - concatMap unravelK ks - unravelK (DArrowK k1 k2) = k1 : unravelK k2 - unravelK t = [t] - go :: Int -> [Maybe DKind] -> Maybe DKind -> PrM [DDec] go _ [] _ = return [] go n (m_arg : m_args) m_result = do @@ -148,6 +141,7 @@ [con_eq_ct] con_name (DNormalC []) + Nothing data_decl = DDataD Data [] data_name params [con_decl] [] app_eqn = DTySynEqn [ foldType (DConT data_name) (map DVarT rest_names) @@ -155,7 +149,8 @@ (foldType (DConT (promoteTySym name (n+1))) (map DVarT (rest_names ++ [fst_name]))) app_decl = DTySynInstD applyName app_eqn - suppress = DInstanceD [] (DConT suppressClassName `DAppT` DConT data_name) + suppress = DInstanceD Nothing [] + (DConT suppressClassName `DAppT` DConT data_name) [DLetDec $ DFunD suppressMethodName [DClause [DWildPa] ((DVarE 'snd) `DAppE` @@ -164,24 +159,24 @@ return $ suppress : data_decl : app_decl : decls buildTyFun :: DKind -> DKind -> DKind -buildTyFun k1 k2 = DConK tyFunName [k1, k2] +buildTyFun k1 k2 = DConT tyFunName `DAppT` k1 `DAppT` k2 buildTyFun_maybe :: Maybe DKind -> Maybe DKind -> Maybe DKind buildTyFun_maybe m_k1 m_k2 = do k1 <- m_k1 k2 <- m_k2 - return $ DConK tyFunName [k1, k2] + return $ DConT tyFunName `DAppT` k1 `DAppT` k2 -- Counts the arity of type level function represented with TyFun constructors tyFunArity :: DKind -> Int -tyFunArity (DArrowK (DConK tyFunNm [_, b]) DStarK) +tyFunArity (DArrowT `DAppT` (DConT tyFunNm `DAppT` _ `DAppT` b) `DAppT` DStarT) | tyFunName == tyFunNm = 1 + tyFunArity b tyFunArity _ = 0 -- Checks if type is (TyFun a b -> *) isTyFun :: DKind -> Bool -isTyFun (DArrowK (DConK tyFunNm [_,_]) DStarK) +isTyFun (DArrowT `DAppT` (DConT tyFunNm `DAppT` _ `DAppT` _) `DAppT` DStarT) | tyFunName == tyFunNm = True isTyFun _ = False diff --git a/src/Data/Singletons/Promote/Eq.hs b/src/Data/Singletons/Promote/Eq.hs --- a/src/Data/Singletons/Promote/Eq.hs +++ b/src/Data/Singletons/Promote/Eq.hs @@ -24,17 +24,18 @@ bName <- qNewName "b" true_branches <- mapM mk_branch cons false_branch <- false_case - let closedFam = DClosedTypeFamilyD helperName - [ DKindedTV aName kind - , DKindedTV bName kind ] - (Just boolKi) + let closedFam = DClosedTypeFamilyD (DTypeFamilyHead helperName + [ DKindedTV aName kind + , DKindedTV bName kind ] + (DKindSig boolKi) + Nothing) (true_branches ++ [false_branch]) eqInst = DTySynInstD tyEqName (DTySynEqn [ DSigT (DVarT aName) kind , DSigT (DVarT bName) kind ] (foldType (DConT helperName) [DVarT aName, DVarT bName])) - inst = DInstanceD [] ((DConT $ promoteClassName eqName) `DAppT` - kindParam kind) [eqInst] + inst = DInstanceD Nothing [] ((DConT $ promoteClassName eqName) `DAppT` + kindParam kind) [eqInst] return [closedFam, inst] diff --git a/src/Data/Singletons/Promote/Monad.hs b/src/Data/Singletons/Promote/Monad.hs --- a/src/Data/Singletons/Promote/Monad.hs +++ b/src/Data/Singletons/Promote/Monad.hs @@ -27,6 +27,10 @@ import Data.Singletons.Names import Data.Singletons.Syntax +#if __GLASGOW_HASKELL__ >= 711 +import Control.Monad.Fail ( MonadFail ) +#endif + type LetExpansions = Map Name DType -- from **term-level** name -- environment during promotion @@ -44,7 +48,11 @@ -- the promotion monad newtype PrM a = PrM (ReaderT PrEnv (WriterT [DDec] Q) a) deriving ( Functor, Applicative, Monad, Quasi - , MonadReader PrEnv, MonadWriter [DDec] ) + , MonadReader PrEnv, MonadWriter [DDec] +#if __GLASGOW_HASKELL__ >= 711 + , MonadFail +#endif + ) instance DsMonad PrM where localDeclarations = asks pr_local_decls diff --git a/src/Data/Singletons/Promote/Type.hs b/src/Data/Singletons/Promote/Type.hs --- a/src/Data/Singletons/Promote/Type.hs +++ b/src/Data/Singletons/Promote/Type.hs @@ -30,19 +30,19 @@ k2 <- go [] t2 go (k2 : args) t1 go args (DSigT ty _) = go args ty -- just ignore signatures - go [] (DVarT name) = return $ DVarK name + go [] (DVarT name) = return $ DVarT name go _ (DVarT name) = fail $ "Cannot promote an applied type variable " ++ show name ++ "." go [] (DConT name) - | name == typeRepName = return DStarK - | name == stringName = return $ DConK symbolName [] - | nameBase name == nameBase repName = return DStarK + | name == typeRepName = return DStarT + | name == stringName = return $ DConT symbolName + | nameBase name == nameBase repName = return DStarT go args (DConT name) | Just n <- unboxedTupleNameDegree_maybe name - = return $ DConK (tupleTypeName n) args + = return $ foldType (DConT (tupleTypeName n)) args | otherwise - = return $ DConK name args - go [k1, k2] DArrowT = return $ addStar (DConK tyFunName [k1, k2]) + = return $ foldType (DConT name) args + go [k1, k2] DArrowT = return $ addStar (DConT tyFunName `DAppT` k1 `DAppT` k2) go _ (DLitT _) = fail "Cannot promote a type-level literal" go args hd = fail $ "Illegal Haskell construct encountered:\n" ++ diff --git a/src/Data/Singletons/Single.hs b/src/Data/Singletons/Single.hs --- a/src/Data/Singletons/Single.hs +++ b/src/Data/Singletons/Single.hs @@ -132,9 +132,9 @@ (tvbs, cons) <- getDataD ("I cannot make an instance of " ++ show className ++ " for it.") name dtvbs <- mapM dsTvb tvbs - dcons <- mapM dsCon cons - let tyvars = map (DVarK . extractTvbName) dtvbs - kind = DConK name tyvars + dcons <- concatMapM dsCon cons + let tyvars = map (DVarT . extractTvbName) dtvbs + kind = foldType (DConT name) tyvars aName <- qNewName "a" let aVar = DVarT aName (scons, _) <- singM [] $ mapM (singCtor aVar) dcons @@ -172,7 +172,7 @@ (tvbs, cons) <- getDataD ("I cannot make an instance of " ++ inst_name ++ " for it.") name dtvbs <- mapM dsTvb tvbs - dcons <- mapM dsCon cons + dcons <- concatMapM dsCon cons raw_inst <- mk_inst (foldType (DConT name) (map tvbToType dtvbs)) dcons (a_inst, decs) <- promoteM [] $ promoteInstanceDec Map.empty raw_inst @@ -184,7 +184,7 @@ singTopLevelDecs [] [dec] singInfo (DPrimTyConI _name _numArgs _unlifted) = fail "Singling of primitive type constructors not supported" -singInfo (DVarI _name _ty _mdec _fixity) = +singInfo (DVarI _name _ty _mdec) = fail "Singling of value info not supported" singInfo (DTyVarI _name _ty) = fail "Singling of type variable info not supported" @@ -222,7 +222,7 @@ concatMap con_num_args cons where con_num_args :: DCon -> [(Name, DExp)] - con_num_args (DCon _tvbs _cxt name fields) = + con_num_args (DCon _tvbs _cxt name fields _rty) = (name, wrapSingFun (length (tysOfConFields fields)) (promoteValRhs name) (DConE $ singDataConName name)) : rec_selectors fields @@ -296,7 +296,8 @@ cxt' <- mapM singPred cxt inst_kis <- mapM promoteType inst_tys meths <- concatMapM (uncurry sing_meth) ann_meths - return (DInstanceD cxt' + return (DInstanceD Nothing + cxt' (foldl DAppT (DConT s_inst_name) (map kindParam inst_kis)) meths) @@ -307,10 +308,19 @@ sing_meth name rhs = do mb_s_info <- dsReify (singValName name) (s_ty, tyvar_names, m_res_ki) <- case mb_s_info of - Just (DVarI _ (DForallT cls_kproxy_tvbs _cls_pred s_ty) _ _) -> do + Just (DVarI _ (DForallT cls_kproxy_tvbs _cls_pred s_ty) _) -> do +#if __GLASGOW_HASKELL__ >= 711 + -- GHC 8 quantifies over the kind vars explicitly + let class_kvs = [ class_kv | DKindedTV class_kv DStarT <- cls_kproxy_tvbs ] +#else let class_kvs = map extract_kv cls_kproxy_tvbs - extract_kv (DKindedTV _kproxyVar (DConK _kproxyTy [DVarK kv])) = kv - extract_kv _ = error "sing_meth cannot extract a kind variable" + extract_kv (DKindedTV _kproxyVar (DConT _kproxyTy `DAppT` DVarT kv)) = kv + extract_kv k = error $ "sing_meth cannot extract a kind variable" ++ + "\n" ++ show k ++ + "\n" ++ show name ++ + "\n" ++ show (singValName name) ++ + "\n" ++ show mb_s_info +#endif (sing_tvbs, _pred, _args, res_ty) = unravel s_ty @@ -320,11 +330,11 @@ _sing `DAppT` (_prom_func `DSigT` res_ki) -> Just (substKind subst res_ki) _ -> Nothing - return (substKindInType subst s_ty, map extractTvbName sing_tvbs, m_res_ki) + return (substType subst s_ty, map extractTvbName sing_tvbs, m_res_ki) _ -> do mb_info <- dsReify name case mb_info of - Just (DVarI _ (DForallT cls_tvbs _cls_pred inner_ty) _ _) -> do + Just (DVarI _ (DForallT cls_tvbs _cls_pred inner_ty) _) -> do let subst = Map.fromList (zip (map extractTvbName cls_tvbs) inst_tys) (s_ty, _num_args, tyvar_names, res_ki) <- singType (promoteValRhs name) @@ -409,9 +419,9 @@ singLetDecRHS :: Map Name [Name] -> Map Name DKind -- result kind (might not be known) -> Name -> ALetDecRHS -> SgM DLetDec -singLetDecRHS _bound_names _res_kis name (AValue prom num_arrows exp) = +singLetDecRHS _bound_names res_kis name (AValue prom num_arrows exp) = DValD (DVarPa (singValName name)) <$> - (wrapUnSingFun num_arrows prom <$> singExp exp) + (wrapUnSingFun num_arrows prom <$> singExp exp (Map.lookup name res_kis)) singLetDecRHS bound_names res_kis name (AFunction prom_fun num_arrows clauses) = let tyvar_names = case Map.lookup name bound_names of Nothing -> [] @@ -434,13 +444,16 @@ (ADClause var_proms pats exp) = do (sPats, prom_pats) <- mapAndUnzipM (singPat (Map.fromList var_proms) Parameter) pats - let equalities = zip (map DVarT bound_names) prom_pats + let bound_name_tys = map DVarT bound_names + equalities = zip bound_name_tys prom_pats -- This res_ki stuff is necessary when we need to propagate result- -- based type-inference. It was inspired by toEnum. (If you remove -- this, that should fail to compile.) - applied_ty = maybe id (\ki -> (`DSigT` ki)) res_ki $ - foldl apply prom_fun prom_pats - sBody <- bindTyVarsEq var_proms applied_ty equalities $ singExp exp + applied_ty = foldl apply prom_fun bound_name_tys `maybeSigT` res_ki + -- We used to use prom_pats as the arguments above, but bound_name_tys + -- is better, because the type variables have kinds. When the pattern + -- is, say, [], then we get a kind ambiguity. See #136. + sBody <- bindTyVarsEq var_proms applied_ty equalities $ singExp exp res_ki -- when calling unSingFun, the prom_pats aren't in scope, so we use the -- bound_names instead let pattern_bound_names = zipWith const bound_names pats @@ -524,33 +537,35 @@ -- calls. Specifically, DON'T do the applySing stuff. Just use sError, which -- has a custom type (Sing x -> a) anyway. -singExp :: ADExp -> SgM DExp +singExp :: ADExp -> Maybe DKind -- the kind of the expression, if known + -> SgM DExp -- See Note [Why error is so special] -singExp (ADVarE err `ADAppE` arg) - | err == errorName = DAppE (DVarE (singValName err)) <$> singExp arg -singExp (ADVarE name) = lookupVarE name -singExp (ADConE name) = lookupConE name -singExp (ADLitE lit) = singLit lit -singExp (ADAppE e1 e2) = do - e1' <- singExp e1 - e2' <- singExp e2 +singExp (ADVarE err `ADAppE` arg) _res_ki + | err == errorName = DAppE (DVarE (singValName err)) <$> + singExp arg (Just (DConT symbolName)) +singExp (ADVarE name) _res_ki = lookupVarE name +singExp (ADConE name) _res_ki = lookupConE name +singExp (ADLitE lit) _res_ki = singLit lit +singExp (ADAppE e1 e2) _res_ki = do + e1' <- singExp e1 Nothing + e2' <- singExp e2 Nothing -- `applySing undefined x` kills type inference, because GHC can't figure -- out the type of `undefined`. So we don't emit that code. if isException e1' then return e1' else return $ (DVarE applySingName) `DAppE` e1' `DAppE` e2' -singExp (ADLamE var_proms prom_lam names exp) = do +singExp (ADLamE var_proms prom_lam names exp) _res_ki = do let sNames = map singValName names exp' <- bindTyVars var_proms (foldl apply prom_lam (map (DVarT . snd) var_proms)) $ - singExp exp + singExp exp Nothing return $ wrapSingFun (length names) prom_lam $ DLamE sNames exp' -singExp (ADCaseE exp prom_exp matches ret_ty) = +singExp (ADCaseE exp prom_exp matches ret_ty) res_ki = -- See Note [Annotate case return type] - DSigE <$> (DCaseE <$> singExp exp <*> mapM (singMatch prom_exp) matches) - <*> pure (singFamily `DAppT` ret_ty) -singExp (ADLetE env exp) = - uncurry DLetE <$> singLetDecEnv env (singExp exp) -singExp (ADSigE {}) = + DSigE <$> (DCaseE <$> singExp exp Nothing <*> mapM (singMatch prom_exp res_ki) matches) + <*> pure (singFamily `DAppT` (ret_ty `maybeSigT` res_ki)) +singExp (ADLetE env exp) res_ki = + uncurry DLetE <$> singLetDecEnv env (singExp exp res_ki) +singExp (ADSigE {}) _ = fail "Singling of explicit type annotations not yet supported." isException :: DExp -> Bool @@ -565,9 +580,10 @@ isException (DSigE e _) = isException e isException (DStaticE e) = isException e -singMatch :: DType -- ^ the promoted scrutinee +singMatch :: DType -- ^ the promoted scrutinee + -> Maybe DKind -- ^ the result kind, if known -> ADMatch -> SgM DMatch -singMatch prom_scrut (ADMatch var_proms prom_match pat exp) = do +singMatch prom_scrut res_ki (ADMatch var_proms prom_match pat exp) = do (sPat, prom_pat) <- singPat (Map.fromList var_proms) CaseStatement pat -- why DAppT below? See comment near decl of ADMatch in LetDecEnv. @@ -577,8 +593,8 @@ , err == errorName -- See Note [Why error is so special] = [] -- no equality from impossible case. | otherwise = [(prom_pat, prom_scrut)] - sExp <- bindTyVarsEq var_proms (prom_match `DAppT` prom_pat) equality $ - singExp exp + sExp <- bindTyVarsEq var_proms (prom_match `DAppT` prom_pat `maybeSigT` res_ki) equality $ + singExp exp res_ki return $ DMatch sPat sExp singLit :: Lit -> SgM DExp @@ -592,3 +608,7 @@ singLit lit = do prom_lit <- promoteLitExp lit return $ DVarE singMethName `DSigE` (singFamily `DAppT` prom_lit) + +maybeSigT :: DType -> Maybe DKind -> DType +maybeSigT ty Nothing = ty +maybeSigT ty (Just ki) = ty `DSigT` ki diff --git a/src/Data/Singletons/Single/Data.hs b/src/Data/Singletons/Single/Data.hs --- a/src/Data/Singletons/Single/Data.hs +++ b/src/Data/Singletons/Single/Data.hs @@ -6,7 +6,7 @@ Singletonizes constructors. -} -{-# LANGUAGE ParallelListComp, TupleSections #-} +{-# LANGUAGE ParallelListComp, TupleSections, LambdaCase #-} module Data.Singletons.Single.Data where @@ -35,18 +35,19 @@ fromSingClauses <- mapM mkFromSingClause ctors toSingClauses <- mapM mkToSingClause ctors let singKindInst = - DInstanceD (map (singKindConstraint . DVarK) tvbNames) + DInstanceD Nothing + (map (singKindConstraint . DVarT) tvbNames) (DAppT (DConT singKindClassName) (kindParam k)) [ DTySynInstD demoteRepName $ DTySynEqn [kindParam k] (foldType (DConT name) - (map (DAppT demote . kindParam . DVarK) tvbNames)) + (map (DAppT demote . kindParam . DVarT) tvbNames)) , DLetDec $ DFunD fromSingName (fromSingClauses `orIfEmpty` emptyMethod aName) , DLetDec $ DFunD toSingName (toSingClauses `orIfEmpty` emptyMethod aName) ] -- SEq instance - sEqInsts <- if elem eqName derivings + sEqInsts <- if any (\case DConPr n -> n == eqName; _ -> False) derivings then mapM (mkEqualityInstance k ctors') [sEqClassDesc, sDecideClassDesc] else return [] @@ -54,7 +55,7 @@ let kindedSynInst = DTySynD (singTyConName name) [] - (singFamily `DSigT` (k `DArrowK` DStarK)) + (singFamily `DSigT` (DArrowT `DAppT` k `DAppT` DStarT)) return $ (DDataInstD Data [] singFamilyName [DSigT a k] ctors' []) : kindedSynInst : @@ -78,7 +79,7 @@ (map (DAppE (DVarE fromSingName) . DVarE) varNames)) mkToSingClause :: DCon -> SgM DClause - mkToSingClause (DCon _tvbs _cxt cname fields) = do + mkToSingClause (DCon _tvbs _cxt cname fields _rty) = do let types = tysOfConFields fields varNames <- mapM (const $ qNewName "b") types svarNames <- mapM (const $ qNewName "c") types @@ -108,8 +109,8 @@ -- polymorphic constructors are handled just -- like monomorphic ones -- the polymorphism in -- the kind is automatic -singCtor a (DCon _tvbs cxt name fields) - | not (null cxt) +singCtor a (DCon _tvbs cxt name fields _rty) + | not (null (filter (not . isEqPred) cxt)) = fail "Singling of constrained constructors not yet supported" | otherwise = do @@ -126,23 +127,33 @@ -- SingI instance emitDecs - [DInstanceD (map (DAppPr (DConPr singIName)) indices) + [DInstanceD Nothing + (map (DAppPr (DConPr singIName)) indices) (DAppT (DConT singIName) (foldType pCon kindedIndices)) [DLetDec $ DValD (DVarPa singMethName) (foldExp sCon (map (const $ DVarE singMethName) types))]] - let conFields = case fields of - DNormalC _ -> DNormalC $ map (NotStrict,) args + let noBang = Bang NoSourceUnpackedness NoSourceStrictness + conFields = case fields of + DNormalC _ -> DNormalC $ map (noBang,) args DRecC rec_fields -> - DRecC [ (singValName field_name, NotStrict, arg) + DRecC [ (singValName field_name, noBang, arg) | (field_name, _, _) <- rec_fields | arg <- args ] return $ DCon tvbs [mkEqPred a (foldType pCon indices)] sName conFields + Nothing where buildArgType :: DType -> DType -> SgM DType buildArgType ty index = do (ty', _, _, _) <- singType index ty return ty' + + isEqPred :: DPred -> Bool + isEqPred (DAppPr f _) = isEqPred f + isEqPred (DSigPr p _) = isEqPred p + isEqPred (DVarPr _) = False + isEqPred (DConPr n) = n == equalityName + isEqPred DWildCardPr = False diff --git a/src/Data/Singletons/Single/Eq.hs b/src/Data/Singletons/Single/Eq.hs --- a/src/Data/Singletons/Single/Eq.hs +++ b/src/Data/Singletons/Single/Eq.hs @@ -29,16 +29,18 @@ methClauses <- if null ctors then mkEmptyMethClauses else mapM mkMeth ctorPairs - return $ DInstanceD (map (\kvar -> (DConPr className) `DAppPr` kindParam kvar) + return $ DInstanceD Nothing + (map (\kvar -> (DConPr className) `DAppPr` kindParam kvar) (getKindVars k)) (DAppT (DConT className) (kindParam k)) [DLetDec $ DFunD methName methClauses] where getKindVars :: DKind -> [DKind] - getKindVars (DVarK x) = [DVarK x] - getKindVars (DConK _ args) = concatMap getKindVars args - getKindVars DStarK = [] - getKindVars (DArrowK arg res) = concatMap getKindVars [arg, res] + getKindVars (DVarT x) = [DVarT x] + getKindVars (DAppT f a) = concatMap getKindVars [f, a] + getKindVars (DConT {}) = [] + getKindVars DStarT = [] + getKindVars DArrowT = [] getKindVars other = error ("getKindVars sees an unusual kind: " ++ show other) diff --git a/src/Data/Singletons/Single/Monad.hs b/src/Data/Singletons/Single/Monad.hs --- a/src/Data/Singletons/Single/Monad.hs +++ b/src/Data/Singletons/Single/Monad.hs @@ -31,6 +31,10 @@ import Control.Monad.Writer import Control.Applicative +#if __GLASGOW_HASKELL__ >= 711 +import Control.Monad.Fail +#endif + -- environment during singling data SgEnv = SgEnv { sg_let_binds :: Map Name DExp -- from the *original* name @@ -45,7 +49,11 @@ -- the singling monad newtype SgM a = SgM (ReaderT SgEnv (WriterT [DDec] Q) a) deriving ( Functor, Applicative, Monad - , MonadReader SgEnv, MonadWriter [DDec] ) + , MonadReader SgEnv, MonadWriter [DDec] +#if __GLASGOW_HASKELL__ >= 711 + , MonadFail +#endif + ) liftSgM :: Q a -> SgM a liftSgM = SgM . lift . lift @@ -67,6 +75,13 @@ qGetQ = liftSgM qGetQ qPutQ = liftSgM `comp1` qPutQ +#if __GLASGOW_HASKELL__ >= 711 + qReifyFixity = liftSgM `comp1` qReifyFixity + qReifyConStrictness = liftSgM `comp1` qReifyConStrictness + qIsExtEnabled = liftSgM `comp1` qIsExtEnabled + qExtsEnabled = liftSgM qExtsEnabled +#endif + qRecover (SgM handler) (SgM body) = do env <- ask (result, aux) <- liftSgM $ @@ -175,7 +190,7 @@ m_dinfo <- liftM2 (<|>) (dsReify sName) (dsReify name) -- try the unrefined name too -- it's needed to bootstrap Enum case m_dinfo of - Just (DVarI _ ty _ _) -> + Just (DVarI _ ty _) -> let num_args = countArgs ty in return $ wrapSingFun num_args (promoteValRhs name) (mk_exp name) _ -> return $ mk_exp name -- lambda-bound diff --git a/src/Data/Singletons/Single/Type.hs b/src/Data/Singletons/Single/Type.hs --- a/src/Data/Singletons/Single/Type.hs +++ b/src/Data/Singletons/Single/Type.hs @@ -52,3 +52,4 @@ kis <- mapM promoteType ctx let sName = singClassName n return $ foldl DAppPr (DConPr sName) (map kindParam kis) +singPredRec _ctx DWildCardPr = return DWildCardPr -- it just might work diff --git a/src/Data/Singletons/Syntax.hs b/src/Data/Singletons/Syntax.hs --- a/src/Data/Singletons/Syntax.hs +++ b/src/Data/Singletons/Syntax.hs @@ -22,7 +22,7 @@ type VarPromotions = [(Name, Name)] -- from term-level name to type-level name -- the relevant part of declarations -data DataDecl = DataDecl NewOrData Name [DTyVarBndr] [DCon] [Name] +data DataDecl = DataDecl NewOrData Name [DTyVarBndr] [DCon] [DPred] data ClassDecl ann = ClassDecl { cd_cxt :: DCxt , cd_name :: Name diff --git a/src/Data/Singletons/TypeLits.hs b/src/Data/Singletons/TypeLits.hs --- a/src/Data/Singletons/TypeLits.hs +++ b/src/Data/Singletons/TypeLits.hs @@ -17,6 +17,7 @@ module Data.Singletons.TypeLits ( Nat, Symbol, + Sing(SNat, SSym), SNat, SSymbol, withKnownNat, withKnownSymbol, Error, ErrorSym0, ErrorSym1, sError, KnownNat, natVal, KnownSymbol, symbolVal, diff --git a/src/Data/Singletons/Util.hs b/src/Data/Singletons/Util.hs --- a/src/Data/Singletons/Util.hs +++ b/src/Data/Singletons/Util.hs @@ -11,7 +11,7 @@ TemplateHaskell, GeneralizedNewtypeDeriving, MultiParamTypeClasses, StandaloneDeriving, UndecidableInstances, MagicHash, UnboxedTuples, - LambdaCase, CPP #-} + LambdaCase, CPP, NoMonomorphismRestriction #-} module Data.Singletons.Util where @@ -26,7 +26,12 @@ import Data.Map ( Map ) import Data.Foldable import Data.Traversable +import Data.Generics +#if __GLASGOW_HASKELL__ >= 711 +import Control.Monad.Fail ( MonadFail ) +#endif + -- The list of types that singletons processes by default basicTypes :: [Name] basicTypes = [ ''Maybe @@ -84,10 +89,10 @@ -- extract the name and types of constructor arguments extractNameTypes :: DCon -> (Name, [DType]) -extractNameTypes (DCon _ _ n fields) = (n, tysOfConFields fields) +extractNameTypes (DCon _ _ n fields _) = (n, tysOfConFields fields) extractName :: DCon -> Name -extractName (DCon _ _ n _) = n +extractName (DCon _ _ n _ _) = n -- is an identifier uppercase? isUpcase :: Name -> Bool @@ -199,6 +204,12 @@ inferMaybeKindTV n Nothing = DPlainTV n inferMaybeKindTV n (Just k) = DKindedTV n k +resultSigToMaybeKind :: DFamilyResultSig -> Maybe DKind +resultSigToMaybeKind DNoSig = Nothing +resultSigToMaybeKind (DKindSig k) = Just k +resultSigToMaybeKind (DTyVarSig (DPlainTV _)) = Nothing +resultSigToMaybeKind (DTyVarSig (DKindedTV _ k)) = Just k + -- Get argument types from an arrow type. Removing ForallT is an -- important preprocessing step required by promoteType. unravel :: DType -> ([DTyVarBndr], [DPred], [DType], DType) @@ -220,27 +231,43 @@ countArgs ty = length args where (_, _, args, _) = unravel ty +-- changes all TyVars not to be NameU's. Workaround for GHC#11812 +noExactTyVars :: Data a => a -> a +noExactTyVars = everywhere go + where + go :: Data a => a -> a + go = mkT fix_tvb `extT` fix_ty `extT` fix_inj_ann + + no_exact_name :: Name -> Name + no_exact_name (Name (OccName occ) (NameU unique)) = mkName (occ ++ show unique) + no_exact_name n = n + + fix_tvb (DPlainTV n) = DPlainTV (no_exact_name n) + fix_tvb (DKindedTV n k) = DKindedTV (no_exact_name n) k + + fix_ty (DVarT n) = DVarT (no_exact_name n) + fix_ty ty = ty + + fix_inj_ann (InjectivityAnn lhs rhs) + = InjectivityAnn (no_exact_name lhs) (map no_exact_name rhs) + substKind :: Map Name DKind -> DKind -> DKind -substKind _ (DForallK {}) = - error "Higher-rank kind encountered in instance method promotion." -substKind subst (DVarK n) = - case Map.lookup n subst of - Just ki -> ki - Nothing -> DVarK n -substKind subst (DConK con kis) = DConK con (map (substKind subst) kis) -substKind subst (DArrowK k1 k2) = DArrowK (substKind subst k1) (substKind subst k2) -substKind _ DStarK = DStarK +substKind = substType substType :: Map Name DType -> DType -> DType substType subst ty | Map.null subst = ty -substType subst (DForallT tvbs cxt inner_ty) = - let subst' = foldr Map.delete subst (map extractTvbName tvbs) - cxt' = map (substPred subst') cxt - inner_ty' = substType subst' inner_ty - in - DForallT tvbs cxt' inner_ty' +substType subst (DForallT tvbs cxt inner_ty) + = DForallT tvbs' cxt' inner_ty' + where + (subst', tvbs') = mapAccumL subst_tvb subst tvbs + cxt' = map (substPred subst') cxt + inner_ty' = substType subst' inner_ty + + subst_tvb s tvb@(DPlainTV n) = (Map.delete n s, tvb) + subst_tvb s (DKindedTV n k) = (Map.delete n s, DKindedTV n (substKind s k)) + substType subst (DAppT ty1 ty2) = substType subst ty1 `DAppT` substType subst ty2 -substType subst (DSigT ty ki) = substType subst ty `DSigT` ki +substType subst (DSigT ty ki) = substType subst ty `DSigT` substType subst ki substType subst (DVarT n) = case Map.lookup n subst of Just ki -> ki @@ -248,6 +275,8 @@ substType _ ty@(DConT {}) = ty substType _ ty@(DArrowT) = ty substType _ ty@(DLitT {}) = ty +substType _ ty@DWildCardT = ty +substType _ ty@DStarT = ty substPred :: Map Name DType -> DPred -> DPred substPred subst pred | Map.null subst = pred @@ -256,41 +285,27 @@ substPred subst (DSigPr pred ki) = DSigPr (substPred subst pred) ki substPred _ pred@(DVarPr {}) = pred substPred _ pred@(DConPr {}) = pred - -substKindInType :: Map Name DKind -> DType -> DType -substKindInType subst ty | Map.null subst = ty -substKindInType subst (DForallT tvbs cxt inner_ty) = - let tvbs' = map (substKindInTvb subst) tvbs - cxt' = map (substKindInPred subst) cxt - inner_ty' = substKindInType subst inner_ty - in - DForallT tvbs' cxt' inner_ty' -substKindInType subst (DAppT ty1 ty2) - = substKindInType subst ty1 `DAppT` substKindInType subst ty2 -substKindInType subst (DSigT ty ki) = substKindInType subst ty `DSigT` substKind subst ki -substKindInType _ ty@(DVarT {}) = ty -substKindInType _ ty@(DConT {}) = ty -substKindInType _ ty@(DArrowT) = ty -substKindInType _ ty@(DLitT {}) = ty +substPred _ pred@DWildCardPr = pred substKindInPred :: Map Name DKind -> DPred -> DPred substKindInPred subst pred | Map.null subst = pred substKindInPred subst (DAppPr pred ty) = - DAppPr (substKindInPred subst pred) (substKindInType subst ty) + DAppPr (substKindInPred subst pred) (substType subst ty) substKindInPred subst (DSigPr pred ki) = DSigPr (substKindInPred subst pred) (substKind subst ki) substKindInPred _ pred@(DVarPr {}) = pred substKindInPred _ pred@(DConPr {}) = pred +substKindInPred _ pred@DWildCardPr = pred substKindInTvb :: Map Name DKind -> DTyVarBndr -> DTyVarBndr substKindInTvb _ tvb@(DPlainTV _) = tvb substKindInTvb subst (DKindedTV n ki) = DKindedTV n (substKind subst ki) addStar :: DKind -> DKind -addStar t = DArrowK t DStarK +addStar t = DAppT (DAppT DArrowT t) DStarT addStar_maybe :: Maybe DKind -> Maybe DKind -addStar_maybe t = DArrowK <$> t <*> pure DStarK +addStar_maybe = fmap addStar -- apply a type to a list of types foldType :: DType -> [DType] -> DType @@ -300,11 +315,6 @@ foldExp :: DExp -> [DExp] -> DExp foldExp = foldl DAppE --- is a kind a variable? -isVarK :: DKind -> Bool -isVarK (DVarK _) = True -isVarK _ = False - -- is a function type? isFunTy :: DType -> Bool isFunTy (DAppT (DAppT DArrowT _) _) = True @@ -335,7 +345,11 @@ -- a monad transformer for writing a monoid alongside returning a Q newtype QWithAux m q a = QWA { runQWA :: WriterT m q a } deriving ( Functor, Applicative, Monad, MonadTrans - , MonadWriter m, MonadReader r ) + , MonadWriter m, MonadReader r +#if __GLASGOW_HASKELL__ >= 711 + , MonadFail +#endif + ) -- make a Quasi instance for easy lifting instance (Quasi q, Monoid m) => Quasi (QWithAux m q) where @@ -355,6 +369,13 @@ qGetQ = lift qGetQ qPutQ = lift `comp1` qPutQ +#if __GLASGOW_HASKELL__ >= 711 + qReifyFixity = lift `comp1` qReifyFixity + qReifyConStrictness = lift `comp1` qReifyConStrictness + qIsExtEnabled = lift `comp1` qIsExtEnabled + qExtsEnabled = lift qExtsEnabled +#endif + qRecover exp handler = do (result, aux) <- lift $ qRecover (evalForPair exp) (evalForPair handler) tell aux @@ -380,7 +401,7 @@ -- run a computation with an auxiliary monoid, return both the result -- of the computation and the monoid result -evalForPair :: Quasi q => QWithAux m q a -> q (a, m) +evalForPair :: QWithAux m q a -> q (a, m) evalForPair = runWriterT . runQWA -- in a computation with an auxiliary map, add a binding to the map diff --git a/tests/SingletonsTestSuite.hs b/tests/SingletonsTestSuite.hs --- a/tests/SingletonsTestSuite.hs +++ b/tests/SingletonsTestSuite.hs @@ -54,6 +54,8 @@ , compileAndDumpStdTest "Fixity" , compileAndDumpStdTest "Undef" , compileAndDumpStdTest "T124" + , compileAndDumpStdTest "T136" + , compileAndDumpStdTest "T136b" ], testCompileAndDumpGroup "Promote" [ compileAndDumpStdTest "Constructors" diff --git a/tests/SingletonsTestSuiteUtils.hs b/tests/SingletonsTestSuiteUtils.hs --- a/tests/SingletonsTestSuiteUtils.hs +++ b/tests/SingletonsTestSuiteUtils.hs @@ -26,7 +26,9 @@ import Data.Version ( Version(..) ) import System.IO.Unsafe ( unsafePerformIO ) +#ifndef CURRENT_PACKAGE_KEY #include "../dist/build/autogen/cabal_macros.h" +#endif -- Some infractructure for handling external process errors data ProcessException = ProcessException String deriving (Typeable) @@ -49,7 +51,11 @@ includePath = "../../dist/build" ghcVersion :: String +#if __GLASGOW_HASKELL__ >= 711 +ghcVersion = ".ghc80" +#else ghcVersion = ".ghc710" +#endif -- The mtl package made an incompatible change between 2.1.3.1 and 2.2.1. Because -- test files are compiled outside of the cabal infrastructure, we need to check @@ -86,7 +92,11 @@ ghcOpts = extraOpts ++ [ "-v0" , "-c" +#if __GLASGOW_HASKELL__ < 711 , "-this-package-key " ++ CURRENT_PACKAGE_KEY -- See Note [-this-package-key hack] +#else + , "-this-unit-id " ++ CURRENT_PACKAGE_KEY +#endif , "-ddump-splices" , "-dsuppress-uniques" , "-fforce-recomp" @@ -112,6 +122,10 @@ , "-XUnboxedTuples" , "-XInstanceSigs" , "-XDefaultSignatures" + , "-XCPP" +#if __GLASGOW_HASKELL__ >= 711 + , "-XTypeInType" +#endif ] -- Note [-this-package-key hack] diff --git a/tests/compile-and-dump/GradingClient/Database.ghc710.template b/tests/compile-and-dump/GradingClient/Database.ghc710.template --- a/tests/compile-and-dump/GradingClient/Database.ghc710.template +++ b/tests/compile-and-dump/GradingClient/Database.ghc710.template @@ -97,7 +97,7 @@ = let lambda :: (t0 ~ ZeroSym0, t1 ~ ZeroSym0) => - Sing (Apply (Apply CompareSym0 ZeroSym0) ZeroSym0 :: Ordering) + Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda = applySing (applySing @@ -115,7 +115,7 @@ t1 ~ Apply SuccSym0 b_0123456789) => Sing a_0123456789 -> Sing b_0123456789 - -> Sing (Apply (Apply CompareSym0 (Apply SuccSym0 a_0123456789)) (Apply SuccSym0 b_0123456789) :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda a_0123456789 b_0123456789 = applySing (applySing @@ -138,7 +138,7 @@ forall _z_0123456789. (t0 ~ ZeroSym0, t1 ~ Apply SuccSym0 _z_0123456789) => Sing _z_0123456789 - -> Sing (Apply (Apply CompareSym0 ZeroSym0) (Apply SuccSym0 _z_0123456789) :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda _z_0123456789 = SLT in lambda _s_z_0123456789 sCompare (SSucc _s_z_0123456789) SZero @@ -147,7 +147,7 @@ forall _z_0123456789. (t0 ~ Apply SuccSym0 _z_0123456789, t1 ~ ZeroSym0) => Sing _z_0123456789 - -> Sing (Apply (Apply CompareSym0 (Apply SuccSym0 _z_0123456789)) ZeroSym0 :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda _z_0123456789 = SGT in lambda _s_z_0123456789 instance SingI Zero where @@ -519,8 +519,7 @@ = let lambda :: forall _z_0123456789. (t ~ _z_0123456789, t ~ Apply SchSym0 '[]) => - Sing _z_0123456789 - -> Sing (Apply (Apply LookupSym0 _z_0123456789) (Apply SchSym0 '[]) :: U) + Sing _z_0123456789 -> Sing (Apply (Apply LookupSym0 t) t :: U) lambda _z_0123456789 = undefined in lambda _s_z_0123456789 sLookup sName (SSch (SCons (SAttr sName' sU) sAttrs)) @@ -530,9 +529,7 @@ t ~ Apply SchSym0 (Apply (Apply (:$) (Apply (Apply AttrSym0 name') u)) attrs)) => Sing name -> Sing name' - -> Sing u - -> Sing attrs - -> Sing (Apply (Apply LookupSym0 name) (Apply SchSym0 (Apply (Apply (:$) (Apply (Apply AttrSym0 name') u)) attrs)) :: U) + -> Sing u -> Sing attrs -> Sing (Apply (Apply LookupSym0 t) t :: U) lambda name name' u attrs = let sScrutinee_0123456789 :: @@ -545,27 +542,26 @@ -> let lambda :: TrueSym0 ~ Let0123456789Scrutinee_0123456789Sym4 name name' u attrs => - Sing (Case_0123456789 name name' u attrs TrueSym0) + Sing (Case_0123456789 name name' u attrs TrueSym0 :: U) lambda = u in lambda SFalse -> let lambda :: FalseSym0 ~ Let0123456789Scrutinee_0123456789Sym4 name name' u attrs => - Sing (Case_0123456789 name name' u attrs FalseSym0) + Sing (Case_0123456789 name name' u attrs FalseSym0 :: U) lambda = applySing (applySing (singFun2 (Proxy :: Proxy LookupSym0) sLookup) name) (applySing (singFun1 (Proxy :: Proxy SchSym0) SSch) attrs) in lambda } :: - Sing (Case_0123456789 name name' u attrs (Let0123456789Scrutinee_0123456789Sym4 name name' u attrs)) + Sing (Case_0123456789 name name' u attrs (Let0123456789Scrutinee_0123456789Sym4 name name' u attrs) :: U) in lambda sName sName' sU sAttrs sOccurs _s_z_0123456789 (SSch SNil) = let lambda :: forall _z_0123456789. (t ~ _z_0123456789, t ~ Apply SchSym0 '[]) => - Sing _z_0123456789 - -> Sing (Apply (Apply OccursSym0 _z_0123456789) (Apply SchSym0 '[]) :: Bool) + Sing _z_0123456789 -> Sing (Apply (Apply OccursSym0 t) t :: Bool) lambda _z_0123456789 = SFalse in lambda _s_z_0123456789 sOccurs sName (SSch (SCons (SAttr sName' _s_z_0123456789) sAttrs)) @@ -576,8 +572,7 @@ Sing name -> Sing name' -> Sing _z_0123456789 - -> Sing attrs - -> Sing (Apply (Apply OccursSym0 name) (Apply SchSym0 (Apply (Apply (:$) (Apply (Apply AttrSym0 name') _z_0123456789)) attrs)) :: Bool) + -> Sing attrs -> Sing (Apply (Apply OccursSym0 t) t :: Bool) lambda name name' _z_0123456789 attrs = applySing (applySing @@ -593,7 +588,7 @@ lambda :: forall _z_0123456789. (t ~ _z_0123456789, t ~ Apply SchSym0 '[]) => Sing _z_0123456789 - -> Sing (Apply (Apply AttrNotInSym0 _z_0123456789) (Apply SchSym0 '[]) :: Bool) + -> Sing (Apply (Apply AttrNotInSym0 t) t :: Bool) lambda _z_0123456789 = STrue in lambda _s_z_0123456789 sAttrNotIn @@ -611,8 +606,7 @@ -> Sing u -> Sing name' -> Sing _z_0123456789 - -> Sing t - -> Sing (Apply (Apply AttrNotInSym0 (Apply (Apply AttrSym0 name) u)) (Apply SchSym0 (Apply (Apply (:$) (Apply (Apply AttrSym0 name') _z_0123456789)) t)) :: Bool) + -> Sing t -> Sing (Apply (Apply AttrNotInSym0 t) t :: Bool) lambda name u name' _z_0123456789 t = applySing (applySing @@ -630,8 +624,7 @@ = let lambda :: forall _z_0123456789. (t ~ Apply SchSym0 '[], t ~ _z_0123456789) => - Sing _z_0123456789 - -> Sing (Apply (Apply DisjointSym0 (Apply SchSym0 '[])) _z_0123456789 :: Bool) + Sing _z_0123456789 -> Sing (Apply (Apply DisjointSym0 t) t :: Bool) lambda _z_0123456789 = STrue in lambda _s_z_0123456789 sDisjoint (SSch (SCons sH sT)) sS @@ -641,8 +634,7 @@ t ~ s) => Sing h -> Sing t - -> Sing s - -> Sing (Apply (Apply DisjointSym0 (Apply SchSym0 (Apply (Apply (:$) h) t))) s :: Bool) + -> Sing s -> Sing (Apply (Apply DisjointSym0 t) t :: Bool) lambda h t s = applySing (applySing @@ -660,9 +652,7 @@ = let lambda :: forall s1 s2. (t ~ Apply SchSym0 s1, t ~ Apply SchSym0 s2) => - Sing s1 - -> Sing s2 - -> Sing (Apply (Apply AppendSym0 (Apply SchSym0 s1)) (Apply SchSym0 s2) :: Schema) + Sing s1 -> Sing s2 -> Sing (Apply (Apply AppendSym0 t) t :: Schema) lambda s1 s2 = applySing (singFun1 (Proxy :: Proxy SchSym0) SSch) diff --git a/tests/compile-and-dump/GradingClient/Database.ghc80.template b/tests/compile-and-dump/GradingClient/Database.ghc80.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/GradingClient/Database.ghc80.template @@ -0,0 +1,4911 @@ +GradingClient/Database.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| data Nat + = Zero | Succ Nat + deriving (Eq, Ord) |] + ======> + data Nat + = Zero | Succ Nat + deriving (Eq, Ord) + type family Equals_0123456789 (a :: Nat) (b :: Nat) :: Bool where + Equals_0123456789 Zero Zero = TrueSym0 + Equals_0123456789 (Succ a) (Succ b) = (:==) a b + Equals_0123456789 (a :: Nat) (b :: Nat) = FalseSym0 + instance PEq (KProxy :: KProxy Nat) where + type (:==) (a :: Nat) (b :: Nat) = Equals_0123456789 a b + type ZeroSym0 = Zero + type SuccSym1 (t :: Nat) = Succ t + instance SuppressUnusedWarnings SuccSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) SuccSym0KindInference GHC.Tuple.()) + data SuccSym0 (l :: TyFun Nat Nat) + = forall arg. KindOf (Apply SuccSym0 arg) ~ KindOf (SuccSym1 arg) => + SuccSym0KindInference + type instance Apply SuccSym0 l = SuccSym1 l + type family Compare_0123456789 (a :: Nat) + (a :: Nat) :: Ordering where + Compare_0123456789 Zero Zero = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] + Compare_0123456789 (Succ a_0123456789) (Succ b_0123456789) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) '[]) + Compare_0123456789 Zero (Succ _z_0123456789) = LTSym0 + Compare_0123456789 (Succ _z_0123456789) Zero = GTSym0 + type Compare_0123456789Sym2 (t :: Nat) (t :: Nat) = + Compare_0123456789 t t + instance SuppressUnusedWarnings Compare_0123456789Sym1 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Compare_0123456789Sym1KindInference GHC.Tuple.()) + data Compare_0123456789Sym1 (l :: Nat) (l :: TyFun Nat Ordering) + = forall arg. KindOf (Apply (Compare_0123456789Sym1 l) arg) ~ KindOf (Compare_0123456789Sym2 l arg) => + Compare_0123456789Sym1KindInference + type instance Apply (Compare_0123456789Sym1 l) l = Compare_0123456789Sym2 l l + instance SuppressUnusedWarnings Compare_0123456789Sym0 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Compare_0123456789Sym0KindInference GHC.Tuple.()) + data Compare_0123456789Sym0 (l :: TyFun Nat (TyFun Nat Ordering + -> Type)) + = forall arg. KindOf (Apply Compare_0123456789Sym0 arg) ~ KindOf (Compare_0123456789Sym1 arg) => + Compare_0123456789Sym0KindInference + type instance Apply Compare_0123456789Sym0 l = Compare_0123456789Sym1 l + instance POrd (KProxy :: KProxy Nat) where + type Compare (a :: Nat) (a :: Nat) = Apply (Apply Compare_0123456789Sym0 a) a + data instance Sing (z :: Nat) + = z ~ Zero => SZero | + forall (n :: Nat). z ~ Succ n => SSucc (Sing (n :: Nat)) + type SNat = (Sing :: Nat -> Type) + instance SingKind (KProxy :: KProxy Nat) where + type DemoteRep (KProxy :: KProxy Nat) = Nat + fromSing SZero = Zero + fromSing (SSucc b) = Succ (fromSing b) + toSing Zero = SomeSing SZero + toSing (Succ b) + = case toSing b :: SomeSing (KProxy :: KProxy Nat) of { + SomeSing c -> SomeSing (SSucc c) } + instance SEq (KProxy :: KProxy Nat) where + (%:==) SZero SZero = STrue + (%:==) SZero (SSucc _) = SFalse + (%:==) (SSucc _) SZero = SFalse + (%:==) (SSucc a) (SSucc b) = (%:==) a b + instance SDecide (KProxy :: KProxy Nat) where + (%~) SZero SZero = Proved Refl + (%~) SZero (SSucc _) + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) (SSucc _) SZero + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) (SSucc a) (SSucc b) + = case (%~) a b of { + Proved Refl -> Proved Refl + Disproved contra + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) } + instance SOrd (KProxy :: KProxy Nat) => + SOrd (KProxy :: KProxy Nat) where + sCompare :: + forall (t0 :: Nat) (t1 :: Nat). + Sing t0 + -> Sing t1 + -> Sing (Apply (Apply (CompareSym0 :: TyFun Nat (TyFun Nat Ordering + -> Type) + -> Type) t0 :: TyFun Nat Ordering + -> Type) t1 :: Ordering) + sCompare SZero SZero + = let + lambda :: + (t0 ~ ZeroSym0, t1 ~ ZeroSym0) => + Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda + = applySing + (applySing + (applySing + (singFun3 (Proxy :: Proxy FoldlSym0) sFoldl) + (singFun2 (Proxy :: Proxy ThenCmpSym0) sThenCmp)) + SEQ) + SNil + in lambda + sCompare (SSucc sA_0123456789) (SSucc sB_0123456789) + = let + lambda :: + forall a_0123456789 b_0123456789. + (t0 ~ Apply SuccSym0 a_0123456789, + t1 ~ Apply SuccSym0 b_0123456789) => + Sing a_0123456789 + -> Sing b_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda a_0123456789 b_0123456789 + = applySing + (applySing + (applySing + (singFun3 (Proxy :: Proxy FoldlSym0) sFoldl) + (singFun2 (Proxy :: Proxy ThenCmpSym0) sThenCmp)) + SEQ) + (applySing + (applySing + (singFun2 (Proxy :: Proxy (:$)) SCons) + (applySing + (applySing + (singFun2 (Proxy :: Proxy CompareSym0) sCompare) a_0123456789) + b_0123456789)) + SNil) + in lambda sA_0123456789 sB_0123456789 + sCompare SZero (SSucc _s_z_0123456789) + = let + lambda :: + forall _z_0123456789. + (t0 ~ ZeroSym0, t1 ~ Apply SuccSym0 _z_0123456789) => + Sing _z_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda _z_0123456789 = SLT + in lambda _s_z_0123456789 + sCompare (SSucc _s_z_0123456789) SZero + = let + lambda :: + forall _z_0123456789. + (t0 ~ Apply SuccSym0 _z_0123456789, t1 ~ ZeroSym0) => + Sing _z_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda _z_0123456789 = SGT + in lambda _s_z_0123456789 + instance SingI Zero where + sing = SZero + instance SingI n => SingI (Succ (n :: Nat)) where + sing = SSucc sing +GradingClient/Database.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| append :: Schema -> Schema -> Schema + append (Sch s1) (Sch s2) = Sch (s1 ++ s2) + attrNotIn :: Attribute -> Schema -> Bool + attrNotIn _ (Sch []) = True + attrNotIn (Attr name u) (Sch ((Attr name' _) : t)) + = (name /= name') && (attrNotIn (Attr name u) (Sch t)) + disjoint :: Schema -> Schema -> Bool + disjoint (Sch []) _ = True + disjoint (Sch (h : t)) s = (attrNotIn h s) && (disjoint (Sch t) s) + occurs :: [AChar] -> Schema -> Bool + occurs _ (Sch []) = False + occurs name (Sch ((Attr name' _) : attrs)) + = name == name' || occurs name (Sch attrs) + lookup :: [AChar] -> Schema -> U + lookup _ (Sch []) = undefined + lookup name (Sch ((Attr name' u) : attrs)) + = if name == name' then u else lookup name (Sch attrs) + + data U + = BOOL | STRING | NAT | VEC U Nat + deriving (Read, Eq, Show) + data AChar + = CA | + CB | + CC | + CD | + CE | + CF | + CG | + CH | + CI | + CJ | + CK | + CL | + CM | + CN | + CO | + CP | + CQ | + CR | + CS | + CT | + CU | + CV | + CW | + CX | + CY | + CZ + deriving (Read, Show, Eq) + data Attribute = Attr [AChar] U + data Schema = Sch [Attribute] |] + ======> + data U + = BOOL | STRING | NAT | VEC U Nat + deriving (Read, Eq, Show) + data AChar + = CA | + CB | + CC | + CD | + CE | + CF | + CG | + CH | + CI | + CJ | + CK | + CL | + CM | + CN | + CO | + CP | + CQ | + CR | + CS | + CT | + CU | + CV | + CW | + CX | + CY | + CZ + deriving (Read, Show, Eq) + data Attribute = Attr [AChar] U + data Schema = Sch [Attribute] + append :: Schema -> Schema -> Schema + append (Sch s1) (Sch s2) = Sch (s1 ++ s2) + attrNotIn :: Attribute -> Schema -> Bool + attrNotIn _ (Sch GHC.Types.[]) = True + attrNotIn (Attr name u) (Sch ((Attr name' _) GHC.Types.: t)) + = ((name /= name') && (attrNotIn (Attr name u) (Sch t))) + disjoint :: Schema -> Schema -> Bool + disjoint (Sch GHC.Types.[]) _ = True + disjoint (Sch (h GHC.Types.: t)) s + = ((attrNotIn h s) && (disjoint (Sch t) s)) + occurs :: [AChar] -> Schema -> Bool + occurs _ (Sch GHC.Types.[]) = False + occurs name (Sch ((Attr name' _) GHC.Types.: attrs)) + = ((name == name') || (occurs name (Sch attrs))) + lookup :: [AChar] -> Schema -> U + lookup _ (Sch GHC.Types.[]) = undefined + lookup name (Sch ((Attr name' u) GHC.Types.: attrs)) + = if (name == name') then u else lookup name (Sch attrs) + type family Equals_0123456789 (a :: U) (b :: U) :: Bool where + Equals_0123456789 BOOL BOOL = TrueSym0 + Equals_0123456789 STRING STRING = TrueSym0 + Equals_0123456789 NAT NAT = TrueSym0 + Equals_0123456789 (VEC a a) (VEC b b) = (:&&) ((:==) a b) ((:==) a b) + Equals_0123456789 (a :: U) (b :: U) = FalseSym0 + instance PEq (KProxy :: KProxy U) where + type (:==) (a :: U) (b :: U) = Equals_0123456789 a b + type BOOLSym0 = BOOL + type STRINGSym0 = STRING + type NATSym0 = NAT + type VECSym2 (t :: U) (t :: Nat) = VEC t t + instance SuppressUnusedWarnings VECSym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) VECSym1KindInference GHC.Tuple.()) + data VECSym1 (l :: U) (l :: TyFun Nat U) + = forall arg. KindOf (Apply (VECSym1 l) arg) ~ KindOf (VECSym2 l arg) => + VECSym1KindInference + type instance Apply (VECSym1 l) l = VECSym2 l l + instance SuppressUnusedWarnings VECSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) VECSym0KindInference GHC.Tuple.()) + data VECSym0 (l :: TyFun U (TyFun Nat U -> Type)) + = forall arg. KindOf (Apply VECSym0 arg) ~ KindOf (VECSym1 arg) => + VECSym0KindInference + type instance Apply VECSym0 l = VECSym1 l + type family Equals_0123456789 (a :: AChar) + (b :: AChar) :: Bool where + Equals_0123456789 CA CA = TrueSym0 + Equals_0123456789 CB CB = TrueSym0 + Equals_0123456789 CC CC = TrueSym0 + Equals_0123456789 CD CD = TrueSym0 + Equals_0123456789 CE CE = TrueSym0 + Equals_0123456789 CF CF = TrueSym0 + Equals_0123456789 CG CG = TrueSym0 + Equals_0123456789 CH CH = TrueSym0 + Equals_0123456789 CI CI = TrueSym0 + Equals_0123456789 CJ CJ = TrueSym0 + Equals_0123456789 CK CK = TrueSym0 + Equals_0123456789 CL CL = TrueSym0 + Equals_0123456789 CM CM = TrueSym0 + Equals_0123456789 CN CN = TrueSym0 + Equals_0123456789 CO CO = TrueSym0 + Equals_0123456789 CP CP = TrueSym0 + Equals_0123456789 CQ CQ = TrueSym0 + Equals_0123456789 CR CR = TrueSym0 + Equals_0123456789 CS CS = TrueSym0 + Equals_0123456789 CT CT = TrueSym0 + Equals_0123456789 CU CU = TrueSym0 + Equals_0123456789 CV CV = TrueSym0 + Equals_0123456789 CW CW = TrueSym0 + Equals_0123456789 CX CX = TrueSym0 + Equals_0123456789 CY CY = TrueSym0 + Equals_0123456789 CZ CZ = TrueSym0 + Equals_0123456789 (a :: AChar) (b :: AChar) = FalseSym0 + instance PEq (KProxy :: KProxy AChar) where + type (:==) (a :: AChar) (b :: AChar) = Equals_0123456789 a b + type CASym0 = CA + type CBSym0 = CB + type CCSym0 = CC + type CDSym0 = CD + type CESym0 = CE + type CFSym0 = CF + type CGSym0 = CG + type CHSym0 = CH + type CISym0 = CI + type CJSym0 = CJ + type CKSym0 = CK + type CLSym0 = CL + type CMSym0 = CM + type CNSym0 = CN + type COSym0 = CO + type CPSym0 = CP + type CQSym0 = CQ + type CRSym0 = CR + type CSSym0 = CS + type CTSym0 = CT + type CUSym0 = CU + type CVSym0 = CV + type CWSym0 = CW + type CXSym0 = CX + type CYSym0 = CY + type CZSym0 = CZ + type AttrSym2 (t :: [AChar]) (t :: U) = Attr t t + instance SuppressUnusedWarnings AttrSym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) AttrSym1KindInference GHC.Tuple.()) + data AttrSym1 (l :: [AChar]) (l :: TyFun U Attribute) + = forall arg. KindOf (Apply (AttrSym1 l) arg) ~ KindOf (AttrSym2 l arg) => + AttrSym1KindInference + type instance Apply (AttrSym1 l) l = AttrSym2 l l + instance SuppressUnusedWarnings AttrSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) AttrSym0KindInference GHC.Tuple.()) + data AttrSym0 (l :: TyFun [AChar] (TyFun U Attribute -> Type)) + = forall arg. KindOf (Apply AttrSym0 arg) ~ KindOf (AttrSym1 arg) => + AttrSym0KindInference + type instance Apply AttrSym0 l = AttrSym1 l + type SchSym1 (t :: [Attribute]) = Sch t + instance SuppressUnusedWarnings SchSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) SchSym0KindInference GHC.Tuple.()) + data SchSym0 (l :: TyFun [Attribute] Schema) + = forall arg. KindOf (Apply SchSym0 arg) ~ KindOf (SchSym1 arg) => + SchSym0KindInference + type instance Apply SchSym0 l = SchSym1 l + type Let0123456789Scrutinee_0123456789Sym4 t t t t = + Let0123456789Scrutinee_0123456789 t t t t + instance SuppressUnusedWarnings Let0123456789Scrutinee_0123456789Sym3 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) + Let0123456789Scrutinee_0123456789Sym3KindInference GHC.Tuple.()) + data Let0123456789Scrutinee_0123456789Sym3 l l l l + = forall arg. KindOf (Apply (Let0123456789Scrutinee_0123456789Sym3 l l l) arg) ~ KindOf (Let0123456789Scrutinee_0123456789Sym4 l l l arg) => + Let0123456789Scrutinee_0123456789Sym3KindInference + type instance Apply (Let0123456789Scrutinee_0123456789Sym3 l l l) l = Let0123456789Scrutinee_0123456789Sym4 l l l l + instance SuppressUnusedWarnings Let0123456789Scrutinee_0123456789Sym2 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) + Let0123456789Scrutinee_0123456789Sym2KindInference GHC.Tuple.()) + data Let0123456789Scrutinee_0123456789Sym2 l l l + = forall arg. KindOf (Apply (Let0123456789Scrutinee_0123456789Sym2 l l) arg) ~ KindOf (Let0123456789Scrutinee_0123456789Sym3 l l arg) => + Let0123456789Scrutinee_0123456789Sym2KindInference + type instance Apply (Let0123456789Scrutinee_0123456789Sym2 l l) l = Let0123456789Scrutinee_0123456789Sym3 l l l + instance SuppressUnusedWarnings Let0123456789Scrutinee_0123456789Sym1 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) + Let0123456789Scrutinee_0123456789Sym1KindInference GHC.Tuple.()) + data Let0123456789Scrutinee_0123456789Sym1 l l + = forall arg. KindOf (Apply (Let0123456789Scrutinee_0123456789Sym1 l) arg) ~ KindOf (Let0123456789Scrutinee_0123456789Sym2 l arg) => + Let0123456789Scrutinee_0123456789Sym1KindInference + type instance Apply (Let0123456789Scrutinee_0123456789Sym1 l) l = Let0123456789Scrutinee_0123456789Sym2 l l + instance SuppressUnusedWarnings Let0123456789Scrutinee_0123456789Sym0 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) + Let0123456789Scrutinee_0123456789Sym0KindInference GHC.Tuple.()) + data Let0123456789Scrutinee_0123456789Sym0 l + = forall arg. KindOf (Apply Let0123456789Scrutinee_0123456789Sym0 arg) ~ KindOf (Let0123456789Scrutinee_0123456789Sym1 arg) => + Let0123456789Scrutinee_0123456789Sym0KindInference + type instance Apply Let0123456789Scrutinee_0123456789Sym0 l = Let0123456789Scrutinee_0123456789Sym1 l + type family Let0123456789Scrutinee_0123456789 name + name' + u + attrs where + Let0123456789Scrutinee_0123456789 name name' u attrs = Apply (Apply (:==$) name) name' + type family Case_0123456789 name name' u attrs t where + Case_0123456789 name name' u attrs True = u + Case_0123456789 name name' u attrs False = Apply (Apply LookupSym0 name) (Apply SchSym0 attrs) + type LookupSym2 (t :: [AChar]) (t :: Schema) = Lookup t t + instance SuppressUnusedWarnings LookupSym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) LookupSym1KindInference GHC.Tuple.()) + data LookupSym1 (l :: [AChar]) (l :: TyFun Schema U) + = forall arg. KindOf (Apply (LookupSym1 l) arg) ~ KindOf (LookupSym2 l arg) => + LookupSym1KindInference + type instance Apply (LookupSym1 l) l = LookupSym2 l l + instance SuppressUnusedWarnings LookupSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) LookupSym0KindInference GHC.Tuple.()) + data LookupSym0 (l :: TyFun [AChar] (TyFun Schema U -> Type)) + = forall arg. KindOf (Apply LookupSym0 arg) ~ KindOf (LookupSym1 arg) => + LookupSym0KindInference + type instance Apply LookupSym0 l = LookupSym1 l + type OccursSym2 (t :: [AChar]) (t :: Schema) = Occurs t t + instance SuppressUnusedWarnings OccursSym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) OccursSym1KindInference GHC.Tuple.()) + data OccursSym1 (l :: [AChar]) (l :: TyFun Schema Bool) + = forall arg. KindOf (Apply (OccursSym1 l) arg) ~ KindOf (OccursSym2 l arg) => + OccursSym1KindInference + type instance Apply (OccursSym1 l) l = OccursSym2 l l + instance SuppressUnusedWarnings OccursSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) OccursSym0KindInference GHC.Tuple.()) + data OccursSym0 (l :: TyFun [AChar] (TyFun Schema Bool -> Type)) + = forall arg. KindOf (Apply OccursSym0 arg) ~ KindOf (OccursSym1 arg) => + OccursSym0KindInference + type instance Apply OccursSym0 l = OccursSym1 l + type AttrNotInSym2 (t :: Attribute) (t :: Schema) = AttrNotIn t t + instance SuppressUnusedWarnings AttrNotInSym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) AttrNotInSym1KindInference GHC.Tuple.()) + data AttrNotInSym1 (l :: Attribute) (l :: TyFun Schema Bool) + = forall arg. KindOf (Apply (AttrNotInSym1 l) arg) ~ KindOf (AttrNotInSym2 l arg) => + AttrNotInSym1KindInference + type instance Apply (AttrNotInSym1 l) l = AttrNotInSym2 l l + instance SuppressUnusedWarnings AttrNotInSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) AttrNotInSym0KindInference GHC.Tuple.()) + data AttrNotInSym0 (l :: TyFun Attribute (TyFun Schema Bool + -> Type)) + = forall arg. KindOf (Apply AttrNotInSym0 arg) ~ KindOf (AttrNotInSym1 arg) => + AttrNotInSym0KindInference + type instance Apply AttrNotInSym0 l = AttrNotInSym1 l + type DisjointSym2 (t :: Schema) (t :: Schema) = Disjoint t t + instance SuppressUnusedWarnings DisjointSym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) DisjointSym1KindInference GHC.Tuple.()) + data DisjointSym1 (l :: Schema) (l :: TyFun Schema Bool) + = forall arg. KindOf (Apply (DisjointSym1 l) arg) ~ KindOf (DisjointSym2 l arg) => + DisjointSym1KindInference + type instance Apply (DisjointSym1 l) l = DisjointSym2 l l + instance SuppressUnusedWarnings DisjointSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) DisjointSym0KindInference GHC.Tuple.()) + data DisjointSym0 (l :: TyFun Schema (TyFun Schema Bool -> Type)) + = forall arg. KindOf (Apply DisjointSym0 arg) ~ KindOf (DisjointSym1 arg) => + DisjointSym0KindInference + type instance Apply DisjointSym0 l = DisjointSym1 l + type AppendSym2 (t :: Schema) (t :: Schema) = Append t t + instance SuppressUnusedWarnings AppendSym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) AppendSym1KindInference GHC.Tuple.()) + data AppendSym1 (l :: Schema) (l :: TyFun Schema Schema) + = forall arg. KindOf (Apply (AppendSym1 l) arg) ~ KindOf (AppendSym2 l arg) => + AppendSym1KindInference + type instance Apply (AppendSym1 l) l = AppendSym2 l l + instance SuppressUnusedWarnings AppendSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) AppendSym0KindInference GHC.Tuple.()) + data AppendSym0 (l :: TyFun Schema (TyFun Schema Schema -> Type)) + = forall arg. KindOf (Apply AppendSym0 arg) ~ KindOf (AppendSym1 arg) => + AppendSym0KindInference + type instance Apply AppendSym0 l = AppendSym1 l + type family Lookup (a :: [AChar]) (a :: Schema) :: U where + Lookup _z_0123456789 (Sch '[]) = Any + Lookup name (Sch ((:) (Attr name' u) attrs)) = Case_0123456789 name name' u attrs (Let0123456789Scrutinee_0123456789Sym4 name name' u attrs) + type family Occurs (a :: [AChar]) (a :: Schema) :: Bool where + Occurs _z_0123456789 (Sch '[]) = FalseSym0 + Occurs name (Sch ((:) (Attr name' _z_0123456789) attrs)) = Apply (Apply (:||$) (Apply (Apply (:==$) name) name')) (Apply (Apply OccursSym0 name) (Apply SchSym0 attrs)) + type family AttrNotIn (a :: Attribute) (a :: Schema) :: Bool where + AttrNotIn _z_0123456789 (Sch '[]) = TrueSym0 + AttrNotIn (Attr name u) (Sch ((:) (Attr name' _z_0123456789) 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 '[]) _z_0123456789 = TrueSym0 + Disjoint (Sch ((:) h t)) s = Apply (Apply (:&&$) (Apply (Apply AttrNotInSym0 h) s)) (Apply (Apply DisjointSym0 (Apply SchSym0 t)) s) + type family Append (a :: Schema) (a :: Schema) :: Schema where + Append (Sch s1) (Sch s2) = Apply SchSym0 (Apply (Apply (:++$) s1) s2) + sLookup :: + forall (t :: [AChar]) (t :: Schema). + Sing t -> Sing t -> Sing (Apply (Apply LookupSym0 t) t :: U) + 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) + sAppend :: + forall (t :: Schema) (t :: Schema). + Sing t -> Sing t -> Sing (Apply (Apply AppendSym0 t) t :: Schema) + sLookup _s_z_0123456789 (SSch SNil) + = let + lambda :: + forall _z_0123456789. + (t ~ _z_0123456789, t ~ Apply SchSym0 '[]) => + Sing _z_0123456789 -> Sing (Apply (Apply LookupSym0 t) t :: U) + lambda _z_0123456789 = undefined + in lambda _s_z_0123456789 + sLookup sName (SSch (SCons (SAttr sName' sU) sAttrs)) + = let + lambda :: + forall name name' u attrs. + (t ~ name, + t ~ Apply SchSym0 (Apply (Apply (:$) (Apply (Apply AttrSym0 name') u)) attrs)) => + Sing name + -> Sing name' + -> Sing u -> Sing attrs -> Sing (Apply (Apply LookupSym0 t) t :: U) + lambda name name' u attrs + = let + sScrutinee_0123456789 :: + Sing (Let0123456789Scrutinee_0123456789Sym4 name name' u attrs) + sScrutinee_0123456789 + = applySing + (applySing (singFun2 (Proxy :: Proxy (:==$)) (%:==)) name) name' + in case sScrutinee_0123456789 of { + STrue + -> let + lambda :: + TrueSym0 ~ Let0123456789Scrutinee_0123456789Sym4 name name' u attrs => + Sing (Case_0123456789 name name' u attrs TrueSym0 :: U) + lambda = u + in lambda + SFalse + -> let + lambda :: + FalseSym0 ~ Let0123456789Scrutinee_0123456789Sym4 name name' u attrs => + Sing (Case_0123456789 name name' u attrs FalseSym0 :: U) + lambda + = applySing + (applySing (singFun2 (Proxy :: Proxy LookupSym0) sLookup) name) + (applySing (singFun1 (Proxy :: Proxy SchSym0) SSch) attrs) + in lambda } :: + Sing (Case_0123456789 name name' u attrs (Let0123456789Scrutinee_0123456789Sym4 name name' u attrs) :: U) + in lambda sName sName' sU sAttrs + sOccurs _s_z_0123456789 (SSch SNil) + = let + lambda :: + forall _z_0123456789. + (t ~ _z_0123456789, t ~ Apply SchSym0 '[]) => + Sing _z_0123456789 -> Sing (Apply (Apply OccursSym0 t) t :: Bool) + lambda _z_0123456789 = SFalse + in lambda _s_z_0123456789 + sOccurs sName (SSch (SCons (SAttr sName' _s_z_0123456789) sAttrs)) + = let + lambda :: + forall name name' _z_0123456789 attrs. + (t ~ name, + t ~ Apply SchSym0 (Apply (Apply (:$) (Apply (Apply AttrSym0 name') _z_0123456789)) attrs)) => + Sing name + -> Sing name' + -> Sing _z_0123456789 + -> Sing attrs -> Sing (Apply (Apply OccursSym0 t) t :: Bool) + lambda name name' _z_0123456789 attrs + = applySing + (applySing + (singFun2 (Proxy :: Proxy (:||$)) (%:||)) + (applySing + (applySing (singFun2 (Proxy :: Proxy (:==$)) (%:==)) name) name')) + (applySing + (applySing (singFun2 (Proxy :: Proxy OccursSym0) sOccurs) name) + (applySing (singFun1 (Proxy :: Proxy SchSym0) SSch) attrs)) + in lambda sName sName' _s_z_0123456789 sAttrs + sAttrNotIn _s_z_0123456789 (SSch SNil) + = let + lambda :: + forall _z_0123456789. + (t ~ _z_0123456789, t ~ Apply SchSym0 '[]) => + Sing _z_0123456789 + -> Sing (Apply (Apply AttrNotInSym0 t) t :: Bool) + lambda _z_0123456789 = STrue + in lambda _s_z_0123456789 + sAttrNotIn + (SAttr sName sU) + (SSch (SCons (SAttr sName' _s_z_0123456789) sT)) + = let + lambda :: + forall name u name' _z_0123456789 t. + (t ~ Apply (Apply AttrSym0 name) u, + t ~ Apply SchSym0 (Apply (Apply (:$) (Apply (Apply AttrSym0 name') _z_0123456789)) t)) => + Sing name + -> Sing u + -> Sing name' + -> Sing _z_0123456789 + -> Sing t -> Sing (Apply (Apply AttrNotInSym0 t) t :: Bool) + lambda name u name' _z_0123456789 t + = applySing + (applySing + (singFun2 (Proxy :: Proxy (:&&$)) (%:&&)) + (applySing + (applySing (singFun2 (Proxy :: Proxy (:/=$)) (%:/=)) name) name')) + (applySing + (applySing + (singFun2 (Proxy :: Proxy AttrNotInSym0) sAttrNotIn) + (applySing + (applySing (singFun2 (Proxy :: Proxy AttrSym0) SAttr) name) u)) + (applySing (singFun1 (Proxy :: Proxy SchSym0) SSch) t)) + in lambda sName sU sName' _s_z_0123456789 sT + sDisjoint (SSch SNil) _s_z_0123456789 + = let + lambda :: + forall _z_0123456789. + (t ~ Apply SchSym0 '[], t ~ _z_0123456789) => + Sing _z_0123456789 -> Sing (Apply (Apply DisjointSym0 t) t :: Bool) + lambda _z_0123456789 = STrue + in lambda _s_z_0123456789 + sDisjoint (SSch (SCons sH sT)) sS + = let + lambda :: + forall h t s. + (t ~ Apply SchSym0 (Apply (Apply (:$) h) t), t ~ s) => + Sing h + -> Sing t + -> Sing s -> Sing (Apply (Apply DisjointSym0 t) t :: Bool) + lambda h t s + = applySing + (applySing + (singFun2 (Proxy :: Proxy (:&&$)) (%:&&)) + (applySing + (applySing (singFun2 (Proxy :: Proxy AttrNotInSym0) sAttrNotIn) h) + s)) + (applySing + (applySing + (singFun2 (Proxy :: Proxy DisjointSym0) sDisjoint) + (applySing (singFun1 (Proxy :: Proxy SchSym0) SSch) t)) + s) + in lambda sH sT sS + sAppend (SSch sS1) (SSch sS2) + = let + lambda :: + forall s1 s2. + (t ~ Apply SchSym0 s1, t ~ Apply SchSym0 s2) => + Sing s1 -> Sing s2 -> Sing (Apply (Apply AppendSym0 t) t :: Schema) + lambda s1 s2 + = applySing + (singFun1 (Proxy :: Proxy SchSym0) SSch) + (applySing + (applySing (singFun2 (Proxy :: Proxy (:++$)) (%:++)) s1) s2) + in lambda sS1 sS2 + data instance Sing (z :: U) + = z ~ BOOL => SBOOL | + z ~ STRING => SSTRING | + z ~ NAT => SNAT | + forall (n :: U) (n :: Nat). z ~ VEC n n => + SVEC (Sing (n :: U)) (Sing (n :: Nat)) + type SU = (Sing :: U -> Type) + instance SingKind (KProxy :: KProxy U) where + type DemoteRep (KProxy :: KProxy U) = U + fromSing SBOOL = BOOL + fromSing SSTRING = STRING + fromSing SNAT = NAT + fromSing (SVEC b b) = VEC (fromSing b) (fromSing b) + toSing BOOL = SomeSing SBOOL + toSing STRING = SomeSing SSTRING + toSing NAT = SomeSing SNAT + toSing (VEC b b) + = case + GHC.Tuple.(,) + (toSing b :: SomeSing (KProxy :: KProxy U)) + (toSing b :: SomeSing (KProxy :: KProxy Nat)) + of { + GHC.Tuple.(,) (SomeSing c) (SomeSing c) -> SomeSing (SVEC c c) } + instance SEq (KProxy :: KProxy U) where + (%:==) SBOOL SBOOL = STrue + (%:==) SBOOL SSTRING = SFalse + (%:==) SBOOL SNAT = SFalse + (%:==) SBOOL (SVEC _ _) = SFalse + (%:==) SSTRING SBOOL = SFalse + (%:==) SSTRING SSTRING = STrue + (%:==) SSTRING SNAT = SFalse + (%:==) SSTRING (SVEC _ _) = SFalse + (%:==) SNAT SBOOL = SFalse + (%:==) SNAT SSTRING = SFalse + (%:==) SNAT SNAT = STrue + (%:==) SNAT (SVEC _ _) = SFalse + (%:==) (SVEC _ _) SBOOL = SFalse + (%:==) (SVEC _ _) SSTRING = SFalse + (%:==) (SVEC _ _) SNAT = SFalse + (%:==) (SVEC a a) (SVEC b b) = (%:&&) ((%:==) a b) ((%:==) a b) + instance SDecide (KProxy :: KProxy U) where + (%~) SBOOL SBOOL = Proved Refl + (%~) SBOOL SSTRING + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SBOOL SNAT + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SBOOL (SVEC _ _) + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SSTRING SBOOL + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SSTRING SSTRING = Proved Refl + (%~) SSTRING SNAT + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SSTRING (SVEC _ _) + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SNAT SBOOL + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SNAT SSTRING + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SNAT SNAT = Proved Refl + (%~) SNAT (SVEC _ _) + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) (SVEC _ _) SBOOL + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) (SVEC _ _) SSTRING + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) (SVEC _ _) SNAT + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) (SVEC a a) (SVEC b b) + = case GHC.Tuple.(,) ((%~) a b) ((%~) a b) of { + GHC.Tuple.(,) (Proved Refl) (Proved Refl) -> Proved Refl + GHC.Tuple.(,) (Disproved contra) _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + GHC.Tuple.(,) _ (Disproved contra) + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) } + data instance Sing (z :: AChar) + = z ~ CA => SCA | + z ~ CB => SCB | + z ~ CC => SCC | + z ~ CD => SCD | + z ~ CE => SCE | + z ~ CF => SCF | + z ~ CG => SCG | + z ~ CH => SCH | + z ~ CI => SCI | + z ~ CJ => SCJ | + z ~ CK => SCK | + z ~ CL => SCL | + z ~ CM => SCM | + z ~ CN => SCN | + z ~ CO => SCO | + z ~ CP => SCP | + z ~ CQ => SCQ | + z ~ CR => SCR | + z ~ CS => SCS | + z ~ CT => SCT | + z ~ CU => SCU | + z ~ CV => SCV | + z ~ CW => SCW | + z ~ CX => SCX | + z ~ CY => SCY | + z ~ CZ => SCZ + type SAChar = (Sing :: AChar -> Type) + instance SingKind (KProxy :: KProxy AChar) where + type DemoteRep (KProxy :: KProxy AChar) = AChar + fromSing SCA = CA + fromSing SCB = CB + fromSing SCC = CC + fromSing SCD = CD + fromSing SCE = CE + fromSing SCF = CF + fromSing SCG = CG + fromSing SCH = CH + fromSing SCI = CI + fromSing SCJ = CJ + fromSing SCK = CK + fromSing SCL = CL + fromSing SCM = CM + fromSing SCN = CN + fromSing SCO = CO + fromSing SCP = CP + fromSing SCQ = CQ + fromSing SCR = CR + fromSing SCS = CS + fromSing SCT = CT + fromSing SCU = CU + fromSing SCV = CV + fromSing SCW = CW + fromSing SCX = CX + fromSing SCY = CY + fromSing SCZ = CZ + toSing CA = SomeSing SCA + toSing CB = SomeSing SCB + toSing CC = SomeSing SCC + toSing CD = SomeSing SCD + toSing CE = SomeSing SCE + toSing CF = SomeSing SCF + toSing CG = SomeSing SCG + toSing CH = SomeSing SCH + toSing CI = SomeSing SCI + toSing CJ = SomeSing SCJ + toSing CK = SomeSing SCK + toSing CL = SomeSing SCL + toSing CM = SomeSing SCM + toSing CN = SomeSing SCN + toSing CO = SomeSing SCO + toSing CP = SomeSing SCP + toSing CQ = SomeSing SCQ + toSing CR = SomeSing SCR + toSing CS = SomeSing SCS + toSing CT = SomeSing SCT + toSing CU = SomeSing SCU + toSing CV = SomeSing SCV + toSing CW = SomeSing SCW + toSing CX = SomeSing SCX + toSing CY = SomeSing SCY + toSing CZ = SomeSing SCZ + instance SEq (KProxy :: KProxy AChar) where + (%:==) SCA SCA = STrue + (%:==) SCA SCB = SFalse + (%:==) SCA SCC = SFalse + (%:==) SCA SCD = SFalse + (%:==) SCA SCE = SFalse + (%:==) SCA SCF = SFalse + (%:==) SCA SCG = SFalse + (%:==) SCA SCH = SFalse + (%:==) SCA SCI = SFalse + (%:==) SCA SCJ = SFalse + (%:==) SCA SCK = SFalse + (%:==) SCA SCL = SFalse + (%:==) SCA SCM = SFalse + (%:==) SCA SCN = SFalse + (%:==) SCA SCO = SFalse + (%:==) SCA SCP = SFalse + (%:==) SCA SCQ = SFalse + (%:==) SCA SCR = SFalse + (%:==) SCA SCS = SFalse + (%:==) SCA SCT = SFalse + (%:==) SCA SCU = SFalse + (%:==) SCA SCV = SFalse + (%:==) SCA SCW = SFalse + (%:==) SCA SCX = SFalse + (%:==) SCA SCY = SFalse + (%:==) SCA SCZ = SFalse + (%:==) SCB SCA = SFalse + (%:==) SCB SCB = STrue + (%:==) SCB SCC = SFalse + (%:==) SCB SCD = SFalse + (%:==) SCB SCE = SFalse + (%:==) SCB SCF = SFalse + (%:==) SCB SCG = SFalse + (%:==) SCB SCH = SFalse + (%:==) SCB SCI = SFalse + (%:==) SCB SCJ = SFalse + (%:==) SCB SCK = SFalse + (%:==) SCB SCL = SFalse + (%:==) SCB SCM = SFalse + (%:==) SCB SCN = SFalse + (%:==) SCB SCO = SFalse + (%:==) SCB SCP = SFalse + (%:==) SCB SCQ = SFalse + (%:==) SCB SCR = SFalse + (%:==) SCB SCS = SFalse + (%:==) SCB SCT = SFalse + (%:==) SCB SCU = SFalse + (%:==) SCB SCV = SFalse + (%:==) SCB SCW = SFalse + (%:==) SCB SCX = SFalse + (%:==) SCB SCY = SFalse + (%:==) SCB SCZ = SFalse + (%:==) SCC SCA = SFalse + (%:==) SCC SCB = SFalse + (%:==) SCC SCC = STrue + (%:==) SCC SCD = SFalse + (%:==) SCC SCE = SFalse + (%:==) SCC SCF = SFalse + (%:==) SCC SCG = SFalse + (%:==) SCC SCH = SFalse + (%:==) SCC SCI = SFalse + (%:==) SCC SCJ = SFalse + (%:==) SCC SCK = SFalse + (%:==) SCC SCL = SFalse + (%:==) SCC SCM = SFalse + (%:==) SCC SCN = SFalse + (%:==) SCC SCO = SFalse + (%:==) SCC SCP = SFalse + (%:==) SCC SCQ = SFalse + (%:==) SCC SCR = SFalse + (%:==) SCC SCS = SFalse + (%:==) SCC SCT = SFalse + (%:==) SCC SCU = SFalse + (%:==) SCC SCV = SFalse + (%:==) SCC SCW = SFalse + (%:==) SCC SCX = SFalse + (%:==) SCC SCY = SFalse + (%:==) SCC SCZ = SFalse + (%:==) SCD SCA = SFalse + (%:==) SCD SCB = SFalse + (%:==) SCD SCC = SFalse + (%:==) SCD SCD = STrue + (%:==) SCD SCE = SFalse + (%:==) SCD SCF = SFalse + (%:==) SCD SCG = SFalse + (%:==) SCD SCH = SFalse + (%:==) SCD SCI = SFalse + (%:==) SCD SCJ = SFalse + (%:==) SCD SCK = SFalse + (%:==) SCD SCL = SFalse + (%:==) SCD SCM = SFalse + (%:==) SCD SCN = SFalse + (%:==) SCD SCO = SFalse + (%:==) SCD SCP = SFalse + (%:==) SCD SCQ = SFalse + (%:==) SCD SCR = SFalse + (%:==) SCD SCS = SFalse + (%:==) SCD SCT = SFalse + (%:==) SCD SCU = SFalse + (%:==) SCD SCV = SFalse + (%:==) SCD SCW = SFalse + (%:==) SCD SCX = SFalse + (%:==) SCD SCY = SFalse + (%:==) SCD SCZ = SFalse + (%:==) SCE SCA = SFalse + (%:==) SCE SCB = SFalse + (%:==) SCE SCC = SFalse + (%:==) SCE SCD = SFalse + (%:==) SCE SCE = STrue + (%:==) SCE SCF = SFalse + (%:==) SCE SCG = SFalse + (%:==) SCE SCH = SFalse + (%:==) SCE SCI = SFalse + (%:==) SCE SCJ = SFalse + (%:==) SCE SCK = SFalse + (%:==) SCE SCL = SFalse + (%:==) SCE SCM = SFalse + (%:==) SCE SCN = SFalse + (%:==) SCE SCO = SFalse + (%:==) SCE SCP = SFalse + (%:==) SCE SCQ = SFalse + (%:==) SCE SCR = SFalse + (%:==) SCE SCS = SFalse + (%:==) SCE SCT = SFalse + (%:==) SCE SCU = SFalse + (%:==) SCE SCV = SFalse + (%:==) SCE SCW = SFalse + (%:==) SCE SCX = SFalse + (%:==) SCE SCY = SFalse + (%:==) SCE SCZ = SFalse + (%:==) SCF SCA = SFalse + (%:==) SCF SCB = SFalse + (%:==) SCF SCC = SFalse + (%:==) SCF SCD = SFalse + (%:==) SCF SCE = SFalse + (%:==) SCF SCF = STrue + (%:==) SCF SCG = SFalse + (%:==) SCF SCH = SFalse + (%:==) SCF SCI = SFalse + (%:==) SCF SCJ = SFalse + (%:==) SCF SCK = SFalse + (%:==) SCF SCL = SFalse + (%:==) SCF SCM = SFalse + (%:==) SCF SCN = SFalse + (%:==) SCF SCO = SFalse + (%:==) SCF SCP = SFalse + (%:==) SCF SCQ = SFalse + (%:==) SCF SCR = SFalse + (%:==) SCF SCS = SFalse + (%:==) SCF SCT = SFalse + (%:==) SCF SCU = SFalse + (%:==) SCF SCV = SFalse + (%:==) SCF SCW = SFalse + (%:==) SCF SCX = SFalse + (%:==) SCF SCY = SFalse + (%:==) SCF SCZ = SFalse + (%:==) SCG SCA = SFalse + (%:==) SCG SCB = SFalse + (%:==) SCG SCC = SFalse + (%:==) SCG SCD = SFalse + (%:==) SCG SCE = SFalse + (%:==) SCG SCF = SFalse + (%:==) SCG SCG = STrue + (%:==) SCG SCH = SFalse + (%:==) SCG SCI = SFalse + (%:==) SCG SCJ = SFalse + (%:==) SCG SCK = SFalse + (%:==) SCG SCL = SFalse + (%:==) SCG SCM = SFalse + (%:==) SCG SCN = SFalse + (%:==) SCG SCO = SFalse + (%:==) SCG SCP = SFalse + (%:==) SCG SCQ = SFalse + (%:==) SCG SCR = SFalse + (%:==) SCG SCS = SFalse + (%:==) SCG SCT = SFalse + (%:==) SCG SCU = SFalse + (%:==) SCG SCV = SFalse + (%:==) SCG SCW = SFalse + (%:==) SCG SCX = SFalse + (%:==) SCG SCY = SFalse + (%:==) SCG SCZ = SFalse + (%:==) SCH SCA = SFalse + (%:==) SCH SCB = SFalse + (%:==) SCH SCC = SFalse + (%:==) SCH SCD = SFalse + (%:==) SCH SCE = SFalse + (%:==) SCH SCF = SFalse + (%:==) SCH SCG = SFalse + (%:==) SCH SCH = STrue + (%:==) SCH SCI = SFalse + (%:==) SCH SCJ = SFalse + (%:==) SCH SCK = SFalse + (%:==) SCH SCL = SFalse + (%:==) SCH SCM = SFalse + (%:==) SCH SCN = SFalse + (%:==) SCH SCO = SFalse + (%:==) SCH SCP = SFalse + (%:==) SCH SCQ = SFalse + (%:==) SCH SCR = SFalse + (%:==) SCH SCS = SFalse + (%:==) SCH SCT = SFalse + (%:==) SCH SCU = SFalse + (%:==) SCH SCV = SFalse + (%:==) SCH SCW = SFalse + (%:==) SCH SCX = SFalse + (%:==) SCH SCY = SFalse + (%:==) SCH SCZ = SFalse + (%:==) SCI SCA = SFalse + (%:==) SCI SCB = SFalse + (%:==) SCI SCC = SFalse + (%:==) SCI SCD = SFalse + (%:==) SCI SCE = SFalse + (%:==) SCI SCF = SFalse + (%:==) SCI SCG = SFalse + (%:==) SCI SCH = SFalse + (%:==) SCI SCI = STrue + (%:==) SCI SCJ = SFalse + (%:==) SCI SCK = SFalse + (%:==) SCI SCL = SFalse + (%:==) SCI SCM = SFalse + (%:==) SCI SCN = SFalse + (%:==) SCI SCO = SFalse + (%:==) SCI SCP = SFalse + (%:==) SCI SCQ = SFalse + (%:==) SCI SCR = SFalse + (%:==) SCI SCS = SFalse + (%:==) SCI SCT = SFalse + (%:==) SCI SCU = SFalse + (%:==) SCI SCV = SFalse + (%:==) SCI SCW = SFalse + (%:==) SCI SCX = SFalse + (%:==) SCI SCY = SFalse + (%:==) SCI SCZ = SFalse + (%:==) SCJ SCA = SFalse + (%:==) SCJ SCB = SFalse + (%:==) SCJ SCC = SFalse + (%:==) SCJ SCD = SFalse + (%:==) SCJ SCE = SFalse + (%:==) SCJ SCF = SFalse + (%:==) SCJ SCG = SFalse + (%:==) SCJ SCH = SFalse + (%:==) SCJ SCI = SFalse + (%:==) SCJ SCJ = STrue + (%:==) SCJ SCK = SFalse + (%:==) SCJ SCL = SFalse + (%:==) SCJ SCM = SFalse + (%:==) SCJ SCN = SFalse + (%:==) SCJ SCO = SFalse + (%:==) SCJ SCP = SFalse + (%:==) SCJ SCQ = SFalse + (%:==) SCJ SCR = SFalse + (%:==) SCJ SCS = SFalse + (%:==) SCJ SCT = SFalse + (%:==) SCJ SCU = SFalse + (%:==) SCJ SCV = SFalse + (%:==) SCJ SCW = SFalse + (%:==) SCJ SCX = SFalse + (%:==) SCJ SCY = SFalse + (%:==) SCJ SCZ = SFalse + (%:==) SCK SCA = SFalse + (%:==) SCK SCB = SFalse + (%:==) SCK SCC = SFalse + (%:==) SCK SCD = SFalse + (%:==) SCK SCE = SFalse + (%:==) SCK SCF = SFalse + (%:==) SCK SCG = SFalse + (%:==) SCK SCH = SFalse + (%:==) SCK SCI = SFalse + (%:==) SCK SCJ = SFalse + (%:==) SCK SCK = STrue + (%:==) SCK SCL = SFalse + (%:==) SCK SCM = SFalse + (%:==) SCK SCN = SFalse + (%:==) SCK SCO = SFalse + (%:==) SCK SCP = SFalse + (%:==) SCK SCQ = SFalse + (%:==) SCK SCR = SFalse + (%:==) SCK SCS = SFalse + (%:==) SCK SCT = SFalse + (%:==) SCK SCU = SFalse + (%:==) SCK SCV = SFalse + (%:==) SCK SCW = SFalse + (%:==) SCK SCX = SFalse + (%:==) SCK SCY = SFalse + (%:==) SCK SCZ = SFalse + (%:==) SCL SCA = SFalse + (%:==) SCL SCB = SFalse + (%:==) SCL SCC = SFalse + (%:==) SCL SCD = SFalse + (%:==) SCL SCE = SFalse + (%:==) SCL SCF = SFalse + (%:==) SCL SCG = SFalse + (%:==) SCL SCH = SFalse + (%:==) SCL SCI = SFalse + (%:==) SCL SCJ = SFalse + (%:==) SCL SCK = SFalse + (%:==) SCL SCL = STrue + (%:==) SCL SCM = SFalse + (%:==) SCL SCN = SFalse + (%:==) SCL SCO = SFalse + (%:==) SCL SCP = SFalse + (%:==) SCL SCQ = SFalse + (%:==) SCL SCR = SFalse + (%:==) SCL SCS = SFalse + (%:==) SCL SCT = SFalse + (%:==) SCL SCU = SFalse + (%:==) SCL SCV = SFalse + (%:==) SCL SCW = SFalse + (%:==) SCL SCX = SFalse + (%:==) SCL SCY = SFalse + (%:==) SCL SCZ = SFalse + (%:==) SCM SCA = SFalse + (%:==) SCM SCB = SFalse + (%:==) SCM SCC = SFalse + (%:==) SCM SCD = SFalse + (%:==) SCM SCE = SFalse + (%:==) SCM SCF = SFalse + (%:==) SCM SCG = SFalse + (%:==) SCM SCH = SFalse + (%:==) SCM SCI = SFalse + (%:==) SCM SCJ = SFalse + (%:==) SCM SCK = SFalse + (%:==) SCM SCL = SFalse + (%:==) SCM SCM = STrue + (%:==) SCM SCN = SFalse + (%:==) SCM SCO = SFalse + (%:==) SCM SCP = SFalse + (%:==) SCM SCQ = SFalse + (%:==) SCM SCR = SFalse + (%:==) SCM SCS = SFalse + (%:==) SCM SCT = SFalse + (%:==) SCM SCU = SFalse + (%:==) SCM SCV = SFalse + (%:==) SCM SCW = SFalse + (%:==) SCM SCX = SFalse + (%:==) SCM SCY = SFalse + (%:==) SCM SCZ = SFalse + (%:==) SCN SCA = SFalse + (%:==) SCN SCB = SFalse + (%:==) SCN SCC = SFalse + (%:==) SCN SCD = SFalse + (%:==) SCN SCE = SFalse + (%:==) SCN SCF = SFalse + (%:==) SCN SCG = SFalse + (%:==) SCN SCH = SFalse + (%:==) SCN SCI = SFalse + (%:==) SCN SCJ = SFalse + (%:==) SCN SCK = SFalse + (%:==) SCN SCL = SFalse + (%:==) SCN SCM = SFalse + (%:==) SCN SCN = STrue + (%:==) SCN SCO = SFalse + (%:==) SCN SCP = SFalse + (%:==) SCN SCQ = SFalse + (%:==) SCN SCR = SFalse + (%:==) SCN SCS = SFalse + (%:==) SCN SCT = SFalse + (%:==) SCN SCU = SFalse + (%:==) SCN SCV = SFalse + (%:==) SCN SCW = SFalse + (%:==) SCN SCX = SFalse + (%:==) SCN SCY = SFalse + (%:==) SCN SCZ = SFalse + (%:==) SCO SCA = SFalse + (%:==) SCO SCB = SFalse + (%:==) SCO SCC = SFalse + (%:==) SCO SCD = SFalse + (%:==) SCO SCE = SFalse + (%:==) SCO SCF = SFalse + (%:==) SCO SCG = SFalse + (%:==) SCO SCH = SFalse + (%:==) SCO SCI = SFalse + (%:==) SCO SCJ = SFalse + (%:==) SCO SCK = SFalse + (%:==) SCO SCL = SFalse + (%:==) SCO SCM = SFalse + (%:==) SCO SCN = SFalse + (%:==) SCO SCO = STrue + (%:==) SCO SCP = SFalse + (%:==) SCO SCQ = SFalse + (%:==) SCO SCR = SFalse + (%:==) SCO SCS = SFalse + (%:==) SCO SCT = SFalse + (%:==) SCO SCU = SFalse + (%:==) SCO SCV = SFalse + (%:==) SCO SCW = SFalse + (%:==) SCO SCX = SFalse + (%:==) SCO SCY = SFalse + (%:==) SCO SCZ = SFalse + (%:==) SCP SCA = SFalse + (%:==) SCP SCB = SFalse + (%:==) SCP SCC = SFalse + (%:==) SCP SCD = SFalse + (%:==) SCP SCE = SFalse + (%:==) SCP SCF = SFalse + (%:==) SCP SCG = SFalse + (%:==) SCP SCH = SFalse + (%:==) SCP SCI = SFalse + (%:==) SCP SCJ = SFalse + (%:==) SCP SCK = SFalse + (%:==) SCP SCL = SFalse + (%:==) SCP SCM = SFalse + (%:==) SCP SCN = SFalse + (%:==) SCP SCO = SFalse + (%:==) SCP SCP = STrue + (%:==) SCP SCQ = SFalse + (%:==) SCP SCR = SFalse + (%:==) SCP SCS = SFalse + (%:==) SCP SCT = SFalse + (%:==) SCP SCU = SFalse + (%:==) SCP SCV = SFalse + (%:==) SCP SCW = SFalse + (%:==) SCP SCX = SFalse + (%:==) SCP SCY = SFalse + (%:==) SCP SCZ = SFalse + (%:==) SCQ SCA = SFalse + (%:==) SCQ SCB = SFalse + (%:==) SCQ SCC = SFalse + (%:==) SCQ SCD = SFalse + (%:==) SCQ SCE = SFalse + (%:==) SCQ SCF = SFalse + (%:==) SCQ SCG = SFalse + (%:==) SCQ SCH = SFalse + (%:==) SCQ SCI = SFalse + (%:==) SCQ SCJ = SFalse + (%:==) SCQ SCK = SFalse + (%:==) SCQ SCL = SFalse + (%:==) SCQ SCM = SFalse + (%:==) SCQ SCN = SFalse + (%:==) SCQ SCO = SFalse + (%:==) SCQ SCP = SFalse + (%:==) SCQ SCQ = STrue + (%:==) SCQ SCR = SFalse + (%:==) SCQ SCS = SFalse + (%:==) SCQ SCT = SFalse + (%:==) SCQ SCU = SFalse + (%:==) SCQ SCV = SFalse + (%:==) SCQ SCW = SFalse + (%:==) SCQ SCX = SFalse + (%:==) SCQ SCY = SFalse + (%:==) SCQ SCZ = SFalse + (%:==) SCR SCA = SFalse + (%:==) SCR SCB = SFalse + (%:==) SCR SCC = SFalse + (%:==) SCR SCD = SFalse + (%:==) SCR SCE = SFalse + (%:==) SCR SCF = SFalse + (%:==) SCR SCG = SFalse + (%:==) SCR SCH = SFalse + (%:==) SCR SCI = SFalse + (%:==) SCR SCJ = SFalse + (%:==) SCR SCK = SFalse + (%:==) SCR SCL = SFalse + (%:==) SCR SCM = SFalse + (%:==) SCR SCN = SFalse + (%:==) SCR SCO = SFalse + (%:==) SCR SCP = SFalse + (%:==) SCR SCQ = SFalse + (%:==) SCR SCR = STrue + (%:==) SCR SCS = SFalse + (%:==) SCR SCT = SFalse + (%:==) SCR SCU = SFalse + (%:==) SCR SCV = SFalse + (%:==) SCR SCW = SFalse + (%:==) SCR SCX = SFalse + (%:==) SCR SCY = SFalse + (%:==) SCR SCZ = SFalse + (%:==) SCS SCA = SFalse + (%:==) SCS SCB = SFalse + (%:==) SCS SCC = SFalse + (%:==) SCS SCD = SFalse + (%:==) SCS SCE = SFalse + (%:==) SCS SCF = SFalse + (%:==) SCS SCG = SFalse + (%:==) SCS SCH = SFalse + (%:==) SCS SCI = SFalse + (%:==) SCS SCJ = SFalse + (%:==) SCS SCK = SFalse + (%:==) SCS SCL = SFalse + (%:==) SCS SCM = SFalse + (%:==) SCS SCN = SFalse + (%:==) SCS SCO = SFalse + (%:==) SCS SCP = SFalse + (%:==) SCS SCQ = SFalse + (%:==) SCS SCR = SFalse + (%:==) SCS SCS = STrue + (%:==) SCS SCT = SFalse + (%:==) SCS SCU = SFalse + (%:==) SCS SCV = SFalse + (%:==) SCS SCW = SFalse + (%:==) SCS SCX = SFalse + (%:==) SCS SCY = SFalse + (%:==) SCS SCZ = SFalse + (%:==) SCT SCA = SFalse + (%:==) SCT SCB = SFalse + (%:==) SCT SCC = SFalse + (%:==) SCT SCD = SFalse + (%:==) SCT SCE = SFalse + (%:==) SCT SCF = SFalse + (%:==) SCT SCG = SFalse + (%:==) SCT SCH = SFalse + (%:==) SCT SCI = SFalse + (%:==) SCT SCJ = SFalse + (%:==) SCT SCK = SFalse + (%:==) SCT SCL = SFalse + (%:==) SCT SCM = SFalse + (%:==) SCT SCN = SFalse + (%:==) SCT SCO = SFalse + (%:==) SCT SCP = SFalse + (%:==) SCT SCQ = SFalse + (%:==) SCT SCR = SFalse + (%:==) SCT SCS = SFalse + (%:==) SCT SCT = STrue + (%:==) SCT SCU = SFalse + (%:==) SCT SCV = SFalse + (%:==) SCT SCW = SFalse + (%:==) SCT SCX = SFalse + (%:==) SCT SCY = SFalse + (%:==) SCT SCZ = SFalse + (%:==) SCU SCA = SFalse + (%:==) SCU SCB = SFalse + (%:==) SCU SCC = SFalse + (%:==) SCU SCD = SFalse + (%:==) SCU SCE = SFalse + (%:==) SCU SCF = SFalse + (%:==) SCU SCG = SFalse + (%:==) SCU SCH = SFalse + (%:==) SCU SCI = SFalse + (%:==) SCU SCJ = SFalse + (%:==) SCU SCK = SFalse + (%:==) SCU SCL = SFalse + (%:==) SCU SCM = SFalse + (%:==) SCU SCN = SFalse + (%:==) SCU SCO = SFalse + (%:==) SCU SCP = SFalse + (%:==) SCU SCQ = SFalse + (%:==) SCU SCR = SFalse + (%:==) SCU SCS = SFalse + (%:==) SCU SCT = SFalse + (%:==) SCU SCU = STrue + (%:==) SCU SCV = SFalse + (%:==) SCU SCW = SFalse + (%:==) SCU SCX = SFalse + (%:==) SCU SCY = SFalse + (%:==) SCU SCZ = SFalse + (%:==) SCV SCA = SFalse + (%:==) SCV SCB = SFalse + (%:==) SCV SCC = SFalse + (%:==) SCV SCD = SFalse + (%:==) SCV SCE = SFalse + (%:==) SCV SCF = SFalse + (%:==) SCV SCG = SFalse + (%:==) SCV SCH = SFalse + (%:==) SCV SCI = SFalse + (%:==) SCV SCJ = SFalse + (%:==) SCV SCK = SFalse + (%:==) SCV SCL = SFalse + (%:==) SCV SCM = SFalse + (%:==) SCV SCN = SFalse + (%:==) SCV SCO = SFalse + (%:==) SCV SCP = SFalse + (%:==) SCV SCQ = SFalse + (%:==) SCV SCR = SFalse + (%:==) SCV SCS = SFalse + (%:==) SCV SCT = SFalse + (%:==) SCV SCU = SFalse + (%:==) SCV SCV = STrue + (%:==) SCV SCW = SFalse + (%:==) SCV SCX = SFalse + (%:==) SCV SCY = SFalse + (%:==) SCV SCZ = SFalse + (%:==) SCW SCA = SFalse + (%:==) SCW SCB = SFalse + (%:==) SCW SCC = SFalse + (%:==) SCW SCD = SFalse + (%:==) SCW SCE = SFalse + (%:==) SCW SCF = SFalse + (%:==) SCW SCG = SFalse + (%:==) SCW SCH = SFalse + (%:==) SCW SCI = SFalse + (%:==) SCW SCJ = SFalse + (%:==) SCW SCK = SFalse + (%:==) SCW SCL = SFalse + (%:==) SCW SCM = SFalse + (%:==) SCW SCN = SFalse + (%:==) SCW SCO = SFalse + (%:==) SCW SCP = SFalse + (%:==) SCW SCQ = SFalse + (%:==) SCW SCR = SFalse + (%:==) SCW SCS = SFalse + (%:==) SCW SCT = SFalse + (%:==) SCW SCU = SFalse + (%:==) SCW SCV = SFalse + (%:==) SCW SCW = STrue + (%:==) SCW SCX = SFalse + (%:==) SCW SCY = SFalse + (%:==) SCW SCZ = SFalse + (%:==) SCX SCA = SFalse + (%:==) SCX SCB = SFalse + (%:==) SCX SCC = SFalse + (%:==) SCX SCD = SFalse + (%:==) SCX SCE = SFalse + (%:==) SCX SCF = SFalse + (%:==) SCX SCG = SFalse + (%:==) SCX SCH = SFalse + (%:==) SCX SCI = SFalse + (%:==) SCX SCJ = SFalse + (%:==) SCX SCK = SFalse + (%:==) SCX SCL = SFalse + (%:==) SCX SCM = SFalse + (%:==) SCX SCN = SFalse + (%:==) SCX SCO = SFalse + (%:==) SCX SCP = SFalse + (%:==) SCX SCQ = SFalse + (%:==) SCX SCR = SFalse + (%:==) SCX SCS = SFalse + (%:==) SCX SCT = SFalse + (%:==) SCX SCU = SFalse + (%:==) SCX SCV = SFalse + (%:==) SCX SCW = SFalse + (%:==) SCX SCX = STrue + (%:==) SCX SCY = SFalse + (%:==) SCX SCZ = SFalse + (%:==) SCY SCA = SFalse + (%:==) SCY SCB = SFalse + (%:==) SCY SCC = SFalse + (%:==) SCY SCD = SFalse + (%:==) SCY SCE = SFalse + (%:==) SCY SCF = SFalse + (%:==) SCY SCG = SFalse + (%:==) SCY SCH = SFalse + (%:==) SCY SCI = SFalse + (%:==) SCY SCJ = SFalse + (%:==) SCY SCK = SFalse + (%:==) SCY SCL = SFalse + (%:==) SCY SCM = SFalse + (%:==) SCY SCN = SFalse + (%:==) SCY SCO = SFalse + (%:==) SCY SCP = SFalse + (%:==) SCY SCQ = SFalse + (%:==) SCY SCR = SFalse + (%:==) SCY SCS = SFalse + (%:==) SCY SCT = SFalse + (%:==) SCY SCU = SFalse + (%:==) SCY SCV = SFalse + (%:==) SCY SCW = SFalse + (%:==) SCY SCX = SFalse + (%:==) SCY SCY = STrue + (%:==) SCY SCZ = SFalse + (%:==) SCZ SCA = SFalse + (%:==) SCZ SCB = SFalse + (%:==) SCZ SCC = SFalse + (%:==) SCZ SCD = SFalse + (%:==) SCZ SCE = SFalse + (%:==) SCZ SCF = SFalse + (%:==) SCZ SCG = SFalse + (%:==) SCZ SCH = SFalse + (%:==) SCZ SCI = SFalse + (%:==) SCZ SCJ = SFalse + (%:==) SCZ SCK = SFalse + (%:==) SCZ SCL = SFalse + (%:==) SCZ SCM = SFalse + (%:==) SCZ SCN = SFalse + (%:==) SCZ SCO = SFalse + (%:==) SCZ SCP = SFalse + (%:==) SCZ SCQ = SFalse + (%:==) SCZ SCR = SFalse + (%:==) SCZ SCS = SFalse + (%:==) SCZ SCT = SFalse + (%:==) SCZ SCU = SFalse + (%:==) SCZ SCV = SFalse + (%:==) SCZ SCW = SFalse + (%:==) SCZ SCX = SFalse + (%:==) SCZ SCY = SFalse + (%:==) SCZ SCZ = STrue + instance SDecide (KProxy :: KProxy AChar) where + (%~) SCA SCA = Proved Refl + (%~) SCA SCB + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCA SCC + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCA SCD + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCA SCE + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCA SCF + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCA SCG + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCA SCH + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCA SCI + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCA SCJ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCA SCK + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCA SCL + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCA SCM + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCA SCN + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCA SCO + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCA SCP + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCA SCQ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCA SCR + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCA SCS + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCA SCT + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCA SCU + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCA SCV + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCA SCW + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCA SCX + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCA SCY + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCA SCZ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCB SCA + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCB SCB = Proved Refl + (%~) SCB SCC + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCB SCD + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCB SCE + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCB SCF + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCB SCG + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCB SCH + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCB SCI + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCB SCJ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCB SCK + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCB SCL + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCB SCM + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCB SCN + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCB SCO + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCB SCP + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCB SCQ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCB SCR + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCB SCS + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCB SCT + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCB SCU + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCB SCV + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCB SCW + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCB SCX + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCB SCY + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCB SCZ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCC SCA + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCC SCB + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCC SCC = Proved Refl + (%~) SCC SCD + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCC SCE + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCC SCF + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCC SCG + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCC SCH + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCC SCI + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCC SCJ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCC SCK + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCC SCL + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCC SCM + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCC SCN + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCC SCO + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCC SCP + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCC SCQ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCC SCR + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCC SCS + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCC SCT + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCC SCU + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCC SCV + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCC SCW + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCC SCX + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCC SCY + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCC SCZ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCD SCA + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCD SCB + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCD SCC + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCD SCD = Proved Refl + (%~) SCD SCE + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCD SCF + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCD SCG + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCD SCH + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCD SCI + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCD SCJ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCD SCK + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCD SCL + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCD SCM + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCD SCN + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCD SCO + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCD SCP + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCD SCQ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCD SCR + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCD SCS + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCD SCT + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCD SCU + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCD SCV + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCD SCW + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCD SCX + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCD SCY + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCD SCZ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCE SCA + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCE SCB + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCE SCC + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCE SCD + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCE SCE = Proved Refl + (%~) SCE SCF + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCE SCG + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCE SCH + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCE SCI + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCE SCJ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCE SCK + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCE SCL + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCE SCM + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCE SCN + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCE SCO + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCE SCP + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCE SCQ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCE SCR + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCE SCS + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCE SCT + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCE SCU + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCE SCV + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCE SCW + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCE SCX + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCE SCY + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCE SCZ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCF SCA + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCF SCB + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCF SCC + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCF SCD + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCF SCE + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCF SCF = Proved Refl + (%~) SCF SCG + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCF SCH + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCF SCI + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCF SCJ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCF SCK + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCF SCL + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCF SCM + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCF SCN + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCF SCO + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCF SCP + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCF SCQ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCF SCR + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCF SCS + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCF SCT + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCF SCU + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCF SCV + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCF SCW + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCF SCX + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCF SCY + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCF SCZ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCG SCA + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCG SCB + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCG SCC + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCG SCD + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCG SCE + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCG SCF + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCG SCG = Proved Refl + (%~) SCG SCH + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCG SCI + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCG SCJ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCG SCK + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCG SCL + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCG SCM + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCG SCN + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCG SCO + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCG SCP + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCG SCQ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCG SCR + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCG SCS + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCG SCT + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCG SCU + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCG SCV + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCG SCW + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCG SCX + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCG SCY + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCG SCZ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCH SCA + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCH SCB + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCH SCC + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCH SCD + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCH SCE + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCH SCF + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCH SCG + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCH SCH = Proved Refl + (%~) SCH SCI + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCH SCJ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCH SCK + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCH SCL + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCH SCM + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCH SCN + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCH SCO + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCH SCP + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCH SCQ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCH SCR + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCH SCS + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCH SCT + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCH SCU + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCH SCV + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCH SCW + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCH SCX + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCH SCY + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCH SCZ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCI SCA + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCI SCB + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCI SCC + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCI SCD + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCI SCE + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCI SCF + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCI SCG + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCI SCH + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCI SCI = Proved Refl + (%~) SCI SCJ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCI SCK + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCI SCL + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCI SCM + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCI SCN + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCI SCO + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCI SCP + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCI SCQ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCI SCR + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCI SCS + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCI SCT + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCI SCU + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCI SCV + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCI SCW + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCI SCX + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCI SCY + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCI SCZ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCJ SCA + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCJ SCB + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCJ SCC + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCJ SCD + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCJ SCE + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCJ SCF + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCJ SCG + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCJ SCH + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCJ SCI + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCJ SCJ = Proved Refl + (%~) SCJ SCK + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCJ SCL + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCJ SCM + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCJ SCN + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCJ SCO + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCJ SCP + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCJ SCQ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCJ SCR + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCJ SCS + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCJ SCT + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCJ SCU + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCJ SCV + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCJ SCW + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCJ SCX + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCJ SCY + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCJ SCZ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCK SCA + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCK SCB + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCK SCC + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCK SCD + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCK SCE + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCK SCF + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCK SCG + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCK SCH + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCK SCI + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCK SCJ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCK SCK = Proved Refl + (%~) SCK SCL + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCK SCM + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCK SCN + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCK SCO + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCK SCP + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCK SCQ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCK SCR + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCK SCS + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCK SCT + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCK SCU + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCK SCV + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCK SCW + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCK SCX + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCK SCY + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCK SCZ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCL SCA + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCL SCB + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCL SCC + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCL SCD + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCL SCE + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCL SCF + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCL SCG + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCL SCH + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCL SCI + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCL SCJ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCL SCK + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCL SCL = Proved Refl + (%~) SCL SCM + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCL SCN + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCL SCO + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCL SCP + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCL SCQ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCL SCR + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCL SCS + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCL SCT + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCL SCU + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCL SCV + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCL SCW + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCL SCX + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCL SCY + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCL SCZ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCM SCA + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCM SCB + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCM SCC + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCM SCD + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCM SCE + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCM SCF + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCM SCG + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCM SCH + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCM SCI + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCM SCJ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCM SCK + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCM SCL + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCM SCM = Proved Refl + (%~) SCM SCN + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCM SCO + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCM SCP + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCM SCQ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCM SCR + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCM SCS + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCM SCT + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCM SCU + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCM SCV + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCM SCW + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCM SCX + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCM SCY + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCM SCZ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCN SCA + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCN SCB + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCN SCC + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCN SCD + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCN SCE + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCN SCF + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCN SCG + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCN SCH + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCN SCI + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCN SCJ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCN SCK + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCN SCL + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCN SCM + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCN SCN = Proved Refl + (%~) SCN SCO + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCN SCP + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCN SCQ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCN SCR + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCN SCS + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCN SCT + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCN SCU + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCN SCV + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCN SCW + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCN SCX + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCN SCY + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCN SCZ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCO SCA + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCO SCB + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCO SCC + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCO SCD + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCO SCE + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCO SCF + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCO SCG + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCO SCH + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCO SCI + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCO SCJ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCO SCK + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCO SCL + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCO SCM + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCO SCN + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCO SCO = Proved Refl + (%~) SCO SCP + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCO SCQ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCO SCR + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCO SCS + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCO SCT + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCO SCU + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCO SCV + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCO SCW + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCO SCX + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCO SCY + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCO SCZ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCP SCA + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCP SCB + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCP SCC + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCP SCD + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCP SCE + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCP SCF + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCP SCG + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCP SCH + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCP SCI + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCP SCJ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCP SCK + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCP SCL + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCP SCM + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCP SCN + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCP SCO + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCP SCP = Proved Refl + (%~) SCP SCQ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCP SCR + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCP SCS + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCP SCT + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCP SCU + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCP SCV + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCP SCW + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCP SCX + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCP SCY + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCP SCZ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCQ SCA + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCQ SCB + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCQ SCC + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCQ SCD + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCQ SCE + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCQ SCF + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCQ SCG + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCQ SCH + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCQ SCI + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCQ SCJ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCQ SCK + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCQ SCL + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCQ SCM + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCQ SCN + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCQ SCO + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCQ SCP + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCQ SCQ = Proved Refl + (%~) SCQ SCR + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCQ SCS + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCQ SCT + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCQ SCU + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCQ SCV + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCQ SCW + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCQ SCX + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCQ SCY + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCQ SCZ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCR SCA + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCR SCB + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCR SCC + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCR SCD + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCR SCE + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCR SCF + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCR SCG + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCR SCH + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCR SCI + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCR SCJ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCR SCK + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCR SCL + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCR SCM + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCR SCN + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCR SCO + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCR SCP + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCR SCQ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCR SCR = Proved Refl + (%~) SCR SCS + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCR SCT + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCR SCU + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCR SCV + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCR SCW + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCR SCX + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCR SCY + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCR SCZ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCS SCA + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCS SCB + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCS SCC + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCS SCD + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCS SCE + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCS SCF + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCS SCG + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCS SCH + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCS SCI + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCS SCJ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCS SCK + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCS SCL + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCS SCM + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCS SCN + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCS SCO + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCS SCP + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCS SCQ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCS SCR + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCS SCS = Proved Refl + (%~) SCS SCT + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCS SCU + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCS SCV + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCS SCW + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCS SCX + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCS SCY + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCS SCZ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCT SCA + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCT SCB + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCT SCC + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCT SCD + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCT SCE + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCT SCF + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCT SCG + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCT SCH + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCT SCI + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCT SCJ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCT SCK + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCT SCL + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCT SCM + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCT SCN + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCT SCO + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCT SCP + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCT SCQ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCT SCR + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCT SCS + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCT SCT = Proved Refl + (%~) SCT SCU + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCT SCV + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCT SCW + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCT SCX + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCT SCY + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCT SCZ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCU SCA + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCU SCB + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCU SCC + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCU SCD + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCU SCE + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCU SCF + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCU SCG + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCU SCH + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCU SCI + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCU SCJ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCU SCK + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCU SCL + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCU SCM + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCU SCN + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCU SCO + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCU SCP + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCU SCQ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCU SCR + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCU SCS + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCU SCT + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCU SCU = Proved Refl + (%~) SCU SCV + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCU SCW + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCU SCX + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCU SCY + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCU SCZ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCV SCA + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCV SCB + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCV SCC + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCV SCD + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCV SCE + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCV SCF + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCV SCG + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCV SCH + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCV SCI + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCV SCJ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCV SCK + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCV SCL + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCV SCM + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCV SCN + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCV SCO + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCV SCP + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCV SCQ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCV SCR + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCV SCS + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCV SCT + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCV SCU + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCV SCV = Proved Refl + (%~) SCV SCW + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCV SCX + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCV SCY + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCV SCZ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCW SCA + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCW SCB + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCW SCC + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCW SCD + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCW SCE + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCW SCF + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCW SCG + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCW SCH + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCW SCI + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCW SCJ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCW SCK + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCW SCL + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCW SCM + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCW SCN + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCW SCO + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCW SCP + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCW SCQ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCW SCR + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCW SCS + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCW SCT + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCW SCU + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCW SCV + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCW SCW = Proved Refl + (%~) SCW SCX + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCW SCY + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCW SCZ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCX SCA + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCX SCB + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCX SCC + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCX SCD + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCX SCE + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCX SCF + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCX SCG + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCX SCH + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCX SCI + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCX SCJ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCX SCK + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCX SCL + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCX SCM + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCX SCN + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCX SCO + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCX SCP + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCX SCQ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCX SCR + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCX SCS + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCX SCT + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCX SCU + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCX SCV + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCX SCW + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCX SCX = Proved Refl + (%~) SCX SCY + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCX SCZ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCY SCA + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCY SCB + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCY SCC + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCY SCD + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCY SCE + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCY SCF + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCY SCG + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCY SCH + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCY SCI + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCY SCJ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCY SCK + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCY SCL + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCY SCM + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCY SCN + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCY SCO + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCY SCP + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCY SCQ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCY SCR + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCY SCS + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCY SCT + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCY SCU + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCY SCV + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCY SCW + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCY SCX + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCY SCY = Proved Refl + (%~) SCY SCZ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCZ SCA + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCZ SCB + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCZ SCC + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCZ SCD + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCZ SCE + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCZ SCF + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCZ SCG + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCZ SCH + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCZ SCI + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCZ SCJ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCZ SCK + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCZ SCL + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCZ SCM + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCZ SCN + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCZ SCO + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCZ SCP + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCZ SCQ + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCZ SCR + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCZ SCS + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCZ SCT + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCZ SCU + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCZ SCV + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCZ SCW + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCZ SCX + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCZ SCY + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SCZ SCZ = Proved Refl + data instance Sing (z :: Attribute) + = forall (n :: [AChar]) (n :: U). z ~ Attr n n => + SAttr (Sing (n :: [AChar])) (Sing (n :: U)) + type SAttribute = (Sing :: Attribute -> Type) + instance SingKind (KProxy :: KProxy Attribute) where + type DemoteRep (KProxy :: KProxy Attribute) = Attribute + fromSing (SAttr b b) = Attr (fromSing b) (fromSing b) + toSing (Attr b b) + = case + GHC.Tuple.(,) + (toSing b :: SomeSing (KProxy :: KProxy [AChar])) + (toSing b :: SomeSing (KProxy :: KProxy U)) + of { + GHC.Tuple.(,) (SomeSing c) (SomeSing c) -> SomeSing (SAttr c c) } + data instance Sing (z :: Schema) + = forall (n :: [Attribute]). z ~ Sch n => + SSch (Sing (n :: [Attribute])) + type SSchema = (Sing :: Schema -> Type) + instance SingKind (KProxy :: KProxy Schema) where + type DemoteRep (KProxy :: KProxy Schema) = Schema + fromSing (SSch b) = Sch (fromSing b) + toSing (Sch b) + = case toSing b :: SomeSing (KProxy :: KProxy [Attribute]) of { + SomeSing c -> SomeSing (SSch c) } + instance SingI BOOL where + sing = SBOOL + instance SingI STRING where + sing = SSTRING + instance SingI NAT where + sing = SNAT + instance (SingI n, SingI n) => + SingI (VEC (n :: U) (n :: Nat)) where + sing = SVEC sing sing + instance SingI CA where + sing = SCA + instance SingI CB where + sing = SCB + instance SingI CC where + sing = SCC + instance SingI CD where + sing = SCD + instance SingI CE where + sing = SCE + instance SingI CF where + sing = SCF + instance SingI CG where + sing = SCG + instance SingI CH where + sing = SCH + instance SingI CI where + sing = SCI + instance SingI CJ where + sing = SCJ + instance SingI CK where + sing = SCK + instance SingI CL where + sing = SCL + instance SingI CM where + sing = SCM + instance SingI CN where + sing = SCN + instance SingI CO where + sing = SCO + instance SingI CP where + sing = SCP + instance SingI CQ where + sing = SCQ + instance SingI CR where + sing = SCR + instance SingI CS where + sing = SCS + instance SingI CT where + sing = SCT + instance SingI CU where + sing = SCU + instance SingI CV where + sing = SCV + instance SingI CW where + sing = SCW + instance SingI CX where + sing = SCX + instance SingI CY where + sing = SCY + instance SingI CZ where + sing = SCZ + instance (SingI n, SingI n) => + SingI (Attr (n :: [AChar]) (n :: U)) where + sing = SAttr sing sing + instance SingI n => SingI (Sch (n :: [Attribute])) where + sing = SSch sing +GradingClient/Database.hs:0:0:: Splicing declarations + return [] ======> +GradingClient/Database.hs:(0,0)-(0,0): Splicing expression + cases ''Row [| r |] [| changeId (n ++ (getId r)) r |] + ======> + case r of { + EmptyRow _ -> changeId ((++) n (getId r)) r + ConsRow _ _ -> changeId ((++) n (getId r)) r } diff --git a/tests/compile-and-dump/GradingClient/Database.hs b/tests/compile-and-dump/GradingClient/Database.hs --- a/tests/compile-and-dump/GradingClient/Database.hs +++ b/tests/compile-and-dump/GradingClient/Database.hs @@ -11,7 +11,7 @@ {-# LANGUAGE PolyKinds, DataKinds, TemplateHaskell, TypeFamilies, GADTs, TypeOperators, RankNTypes, FlexibleContexts, UndecidableInstances, FlexibleInstances, ScopedTypeVariables, MultiParamTypeClasses, - ConstraintKinds, CPP #-} + ConstraintKinds, CPP, InstanceSigs #-} {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} -- The OverlappingInstances is needed only to allow the InC and SubsetC classes. @@ -23,7 +23,7 @@ module GradingClient.Database where import Prelude hiding ( tail, id ) -import Data.Singletons.Prelude +import Data.Singletons.Prelude hiding ( Lookup, sLookup ) import Data.Singletons.SuppressUnusedWarnings import Data.Singletons.TH import Control.Monad @@ -35,6 +35,10 @@ import Control.Monad.Error ( throwError ) #endif +#if __GLASGOW_HASKELL__ >= 711 +import Data.Kind +#endif + $(singletons [d| -- Basic Nat type data Nat = Zero | Succ Nat deriving (Eq, Ord) @@ -490,7 +494,9 @@ -- for incomplete pattern matches when the remaining cases are impossible. -- So, we include this case (impossible to reach for any terminated value) -- to suppress the warning. +#if __GLASGOW_HASKELL__ < 711 _ -> error "Type checking failed" +#endif -- Retrieves the element, looked up by the name of the provided attribute, -- from a row. The explicit quantification is necessary to create the scoped @@ -501,11 +507,15 @@ InElt -> case r of ConsRow h _ -> h -- EmptyRow _ -> undefined <== IMPOSSIBLE +#if __GLASGOW_HASKELL__ < 711 _ -> error "Type checking failed" +#endif InTail -> case r of ConsRow _ t -> extractElt attr t -- EmptyRow _ -> undefined <== IMPOSSBLE +#if __GLASGOW_HASKELL__ < 711 _ -> error "Type checking failed" +#endif query (Select expr r) = do rows <- query r @@ -525,7 +535,9 @@ STrue -> h SFalse -> withSingI stail (eval (Element (SSch stail) name) t) _ -> bugInGHC +#if __GLASGOW_HASKELL__ < 711 _ -> bugInGHC +#endif eval (Equal (e1 :: Expr s' u') e2) row = let v1 = eval e1 row @@ -541,3 +553,20 @@ v1 < v2 eval (LiteralNat x) _ = toNat x + +data G a where + GCons :: G ('Sch (a ': b)) + +data H a where + HCons :: H ('Sch (a ': b)) + HNil :: H ('Sch '[]) + +data J a where + JCons :: J (a ': b) + JNil :: J '[] + +eval :: G s -> Sing s -> () +eval GCons s = + case s of + -- SSch SNil -> undefined -- <== IMPOSSIBLE + SSch (SCons _ _) -> undefined diff --git a/tests/compile-and-dump/GradingClient/Main.ghc80.template b/tests/compile-and-dump/GradingClient/Main.ghc80.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/GradingClient/Main.ghc80.template @@ -0,0 +1,162 @@ +GradingClient/Main.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| lastName, firstName, yearName, gradeName, majorName :: [AChar] + lastName = [CL, CA, CS, CT] + firstName = [CF, CI, CR, CS, CT] + yearName = [CY, CE, CA, CR] + gradeName = [CG, CR, CA, CD, CE] + majorName = [CM, CA, CJ, CO, CR] + gradingSchema :: Schema + gradingSchema + = Sch + [Attr lastName STRING, Attr firstName STRING, Attr yearName NAT, + Attr gradeName NAT, Attr majorName BOOL] + names :: Schema + names = Sch [Attr firstName STRING, Attr lastName STRING] |] + ======> + lastName :: [AChar] + firstName :: [AChar] + yearName :: [AChar] + gradeName :: [AChar] + majorName :: [AChar] + lastName = [CL, CA, CS, CT] + firstName = [CF, CI, CR, CS, CT] + yearName = [CY, CE, CA, CR] + gradeName = [CG, CR, CA, CD, CE] + majorName = [CM, CA, CJ, CO, CR] + gradingSchema :: Schema + gradingSchema + = Sch + [Attr lastName STRING, Attr firstName STRING, Attr yearName NAT, + Attr gradeName NAT, Attr majorName BOOL] + names :: Schema + names = Sch [Attr firstName STRING, Attr lastName STRING] + type MajorNameSym0 = MajorName + type GradeNameSym0 = GradeName + type YearNameSym0 = YearName + type FirstNameSym0 = FirstName + type LastNameSym0 = LastName + type GradingSchemaSym0 = GradingSchema + type NamesSym0 = Names + 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 + GradeName = Apply (Apply (:$) CGSym0) (Apply (Apply (:$) CRSym0) (Apply (Apply (:$) CASym0) (Apply (Apply (:$) CDSym0) (Apply (Apply (:$) CESym0) '[])))) + type family YearName :: [AChar] where + YearName = Apply (Apply (:$) CYSym0) (Apply (Apply (:$) CESym0) (Apply (Apply (:$) CASym0) (Apply (Apply (:$) CRSym0) '[]))) + type family FirstName :: [AChar] where + 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)) '[])) + 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) + sMajorName + = applySing + (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SCM) + (applySing + (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SCA) + (applySing + (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SCJ) + (applySing + (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SCO) + (applySing + (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SCR) SNil)))) + sGradeName + = applySing + (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SCG) + (applySing + (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SCR) + (applySing + (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SCA) + (applySing + (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SCD) + (applySing + (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SCE) SNil)))) + sYearName + = applySing + (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SCY) + (applySing + (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SCE) + (applySing + (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SCA) + (applySing + (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SCR) SNil))) + sFirstName + = applySing + (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SCF) + (applySing + (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SCI) + (applySing + (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SCR) + (applySing + (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SCS) + (applySing + (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SCT) SNil)))) + sLastName + = applySing + (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SCL) + (applySing + (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SCA) + (applySing + (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SCS) + (applySing + (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SCT) SNil))) + sGradingSchema + = applySing + (singFun1 (Proxy :: Proxy SchSym0) SSch) + (applySing + (applySing + (singFun2 (Proxy :: Proxy (:$)) SCons) + (applySing + (applySing (singFun2 (Proxy :: Proxy AttrSym0) SAttr) sLastName) + SSTRING)) + (applySing + (applySing + (singFun2 (Proxy :: Proxy (:$)) SCons) + (applySing + (applySing (singFun2 (Proxy :: Proxy AttrSym0) SAttr) sFirstName) + SSTRING)) + (applySing + (applySing + (singFun2 (Proxy :: Proxy (:$)) SCons) + (applySing + (applySing (singFun2 (Proxy :: Proxy AttrSym0) SAttr) sYearName) + SNAT)) + (applySing + (applySing + (singFun2 (Proxy :: Proxy (:$)) SCons) + (applySing + (applySing (singFun2 (Proxy :: Proxy AttrSym0) SAttr) sGradeName) + SNAT)) + (applySing + (applySing + (singFun2 (Proxy :: Proxy (:$)) SCons) + (applySing + (applySing (singFun2 (Proxy :: Proxy AttrSym0) SAttr) sMajorName) + SBOOL)) + SNil))))) + sNames + = applySing + (singFun1 (Proxy :: Proxy SchSym0) SSch) + (applySing + (applySing + (singFun2 (Proxy :: Proxy (:$)) SCons) + (applySing + (applySing (singFun2 (Proxy :: Proxy AttrSym0) SAttr) sFirstName) + SSTRING)) + (applySing + (applySing + (singFun2 (Proxy :: Proxy (:$)) SCons) + (applySing + (applySing (singFun2 (Proxy :: Proxy AttrSym0) SAttr) sLastName) + SSTRING)) + SNil)) diff --git a/tests/compile-and-dump/InsertionSort/InsertionSortImp.ghc710.template b/tests/compile-and-dump/InsertionSort/InsertionSortImp.ghc710.template --- a/tests/compile-and-dump/InsertionSort/InsertionSortImp.ghc710.template +++ b/tests/compile-and-dump/InsertionSort/InsertionSortImp.ghc710.template @@ -150,8 +150,7 @@ = let lambda :: forall _z_0123456789. (t ~ ZeroSym0, t ~ _z_0123456789) => - Sing _z_0123456789 - -> Sing (Apply (Apply LeqSym0 ZeroSym0) _z_0123456789 :: Bool) + Sing _z_0123456789 -> Sing (Apply (Apply LeqSym0 t) t :: Bool) lambda _z_0123456789 = STrue in lambda _s_z_0123456789 sLeq (SSucc _s_z_0123456789) SZero @@ -159,17 +158,14 @@ lambda :: forall _z_0123456789. (t ~ Apply SuccSym0 _z_0123456789, t ~ ZeroSym0) => - Sing _z_0123456789 - -> Sing (Apply (Apply LeqSym0 (Apply SuccSym0 _z_0123456789)) ZeroSym0 :: Bool) + Sing _z_0123456789 -> Sing (Apply (Apply LeqSym0 t) t :: Bool) lambda _z_0123456789 = SFalse in lambda _s_z_0123456789 sLeq (SSucc sA) (SSucc sB) = let lambda :: forall a b. (t ~ Apply SuccSym0 a, t ~ Apply SuccSym0 b) => - Sing a - -> Sing b - -> Sing (Apply (Apply LeqSym0 (Apply SuccSym0 a)) (Apply SuccSym0 b) :: Bool) + Sing a -> Sing b -> Sing (Apply (Apply LeqSym0 t) t :: Bool) lambda a b = applySing (applySing (singFun2 (Proxy :: Proxy LeqSym0) sLeq) a) b @@ -178,7 +174,7 @@ = let lambda :: forall n. (t ~ n, t ~ '[]) => - Sing n -> Sing (Apply (Apply InsertSym0 n) '[] :: [Nat]) + Sing n -> Sing (Apply (Apply InsertSym0 t) t :: [Nat]) lambda n = applySing (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) n) SNil @@ -188,9 +184,7 @@ lambda :: forall n h t. (t ~ n, t ~ Apply (Apply (:$) h) t) => Sing n - -> Sing h - -> Sing t - -> Sing (Apply (Apply InsertSym0 n) (Apply (Apply (:$) h) t) :: [Nat]) + -> Sing h -> Sing t -> Sing (Apply (Apply InsertSym0 t) t :: [Nat]) lambda n h t = let sScrutinee_0123456789 :: @@ -203,7 +197,7 @@ -> let lambda :: TrueSym0 ~ Let0123456789Scrutinee_0123456789Sym3 n h t => - Sing (Case_0123456789 n h t TrueSym0) + Sing (Case_0123456789 n h t TrueSym0 :: [Nat]) lambda = applySing (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) n) @@ -213,27 +207,25 @@ -> let lambda :: FalseSym0 ~ Let0123456789Scrutinee_0123456789Sym3 n h t => - Sing (Case_0123456789 n h t FalseSym0) + Sing (Case_0123456789 n h t FalseSym0 :: [Nat]) lambda = applySing (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) h) (applySing (applySing (singFun2 (Proxy :: Proxy InsertSym0) sInsert) n) t) in lambda } :: - Sing (Case_0123456789 n h t (Let0123456789Scrutinee_0123456789Sym3 n h t)) + Sing (Case_0123456789 n h t (Let0123456789Scrutinee_0123456789Sym3 n h t) :: [Nat]) in lambda sN sH sT sInsertionSort SNil = let - lambda :: t ~ '[] => Sing (Apply InsertionSortSym0 '[] :: [Nat]) + lambda :: t ~ '[] => Sing (Apply InsertionSortSym0 t :: [Nat]) lambda = SNil in lambda sInsertionSort (SCons sH sT) = let lambda :: forall h t. t ~ Apply (Apply (:$) h) t => - Sing h - -> Sing t - -> Sing (Apply InsertionSortSym0 (Apply (Apply (:$) h) t) :: [Nat]) + Sing h -> Sing t -> Sing (Apply InsertionSortSym0 t :: [Nat]) lambda h t = applySing (applySing (singFun2 (Proxy :: Proxy InsertSym0) sInsert) h) diff --git a/tests/compile-and-dump/InsertionSort/InsertionSortImp.ghc80.template b/tests/compile-and-dump/InsertionSort/InsertionSortImp.ghc80.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/InsertionSort/InsertionSortImp.ghc80.template @@ -0,0 +1,240 @@ +InsertionSort/InsertionSortImp.hs:(0,0)-(0,0): Splicing declarations + singletons [d| data Nat = Zero | Succ Nat |] + ======> + data Nat = Zero | Succ Nat + type ZeroSym0 = Zero + type SuccSym1 (t :: Nat) = Succ t + instance SuppressUnusedWarnings SuccSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) SuccSym0KindInference GHC.Tuple.()) + data SuccSym0 (l :: TyFun Nat Nat) + = forall arg. KindOf (Apply SuccSym0 arg) ~ KindOf (SuccSym1 arg) => + SuccSym0KindInference + type instance Apply SuccSym0 l = SuccSym1 l + data instance Sing (z :: Nat) + = z ~ Zero => SZero | + forall (n :: Nat). z ~ Succ n => SSucc (Sing (n :: Nat)) + type SNat = (Sing :: Nat -> GHC.Types.Type) + instance SingKind (KProxy :: KProxy Nat) where + type DemoteRep (KProxy :: KProxy Nat) = Nat + fromSing SZero = Zero + fromSing (SSucc b) = Succ (fromSing b) + toSing Zero = SomeSing SZero + toSing (Succ b) + = case toSing b :: SomeSing (KProxy :: KProxy Nat) of { + SomeSing c -> SomeSing (SSucc c) } + instance SingI Zero where + sing = SZero + instance SingI n => SingI (Succ (n :: Nat)) where + sing = SSucc sing +InsertionSort/InsertionSortImp.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| leq :: Nat -> Nat -> Bool + leq Zero _ = True + leq (Succ _) Zero = False + leq (Succ a) (Succ b) = leq a b + insert :: Nat -> [Nat] -> [Nat] + insert n [] = [n] + insert n (h : t) + = if leq n h then (n : h : t) else h : (insert n t) + insertionSort :: [Nat] -> [Nat] + insertionSort [] = [] + insertionSort (h : t) = insert h (insertionSort t) |] + ======> + leq :: Nat -> Nat -> Bool + leq Zero _ = True + leq (Succ _) Zero = False + leq (Succ a) (Succ b) = leq a b + insert :: Nat -> [Nat] -> [Nat] + insert n GHC.Types.[] = [n] + insert n (h GHC.Types.: t) + = if leq n h then + (n GHC.Types.: (h GHC.Types.: t)) + else + (h GHC.Types.: (insert n t)) + insertionSort :: [Nat] -> [Nat] + insertionSort GHC.Types.[] = [] + insertionSort (h GHC.Types.: t) = insert h (insertionSort t) + type Let0123456789Scrutinee_0123456789Sym3 t t t = + Let0123456789Scrutinee_0123456789 t t t + instance SuppressUnusedWarnings Let0123456789Scrutinee_0123456789Sym2 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) + Let0123456789Scrutinee_0123456789Sym2KindInference GHC.Tuple.()) + data Let0123456789Scrutinee_0123456789Sym2 l l l + = forall arg. KindOf (Apply (Let0123456789Scrutinee_0123456789Sym2 l l) arg) ~ KindOf (Let0123456789Scrutinee_0123456789Sym3 l l arg) => + Let0123456789Scrutinee_0123456789Sym2KindInference + type instance Apply (Let0123456789Scrutinee_0123456789Sym2 l l) l = Let0123456789Scrutinee_0123456789Sym3 l l l + instance SuppressUnusedWarnings Let0123456789Scrutinee_0123456789Sym1 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) + Let0123456789Scrutinee_0123456789Sym1KindInference GHC.Tuple.()) + data Let0123456789Scrutinee_0123456789Sym1 l l + = forall arg. KindOf (Apply (Let0123456789Scrutinee_0123456789Sym1 l) arg) ~ KindOf (Let0123456789Scrutinee_0123456789Sym2 l arg) => + Let0123456789Scrutinee_0123456789Sym1KindInference + type instance Apply (Let0123456789Scrutinee_0123456789Sym1 l) l = Let0123456789Scrutinee_0123456789Sym2 l l + instance SuppressUnusedWarnings Let0123456789Scrutinee_0123456789Sym0 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) + Let0123456789Scrutinee_0123456789Sym0KindInference GHC.Tuple.()) + data Let0123456789Scrutinee_0123456789Sym0 l + = forall arg. KindOf (Apply Let0123456789Scrutinee_0123456789Sym0 arg) ~ KindOf (Let0123456789Scrutinee_0123456789Sym1 arg) => + Let0123456789Scrutinee_0123456789Sym0KindInference + type instance Apply Let0123456789Scrutinee_0123456789Sym0 l = Let0123456789Scrutinee_0123456789Sym1 l + type family Let0123456789Scrutinee_0123456789 n h t where + Let0123456789Scrutinee_0123456789 n h t = Apply (Apply LeqSym0 n) h + type family Case_0123456789 n h t t where + Case_0123456789 n h t True = Apply (Apply (:$) n) (Apply (Apply (:$) h) t) + Case_0123456789 n h t False = Apply (Apply (:$) h) (Apply (Apply InsertSym0 n) t) + type LeqSym2 (t :: Nat) (t :: Nat) = Leq t t + instance SuppressUnusedWarnings LeqSym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) LeqSym1KindInference GHC.Tuple.()) + data LeqSym1 (l :: Nat) (l :: TyFun Nat Bool) + = forall arg. KindOf (Apply (LeqSym1 l) arg) ~ KindOf (LeqSym2 l arg) => + LeqSym1KindInference + type instance Apply (LeqSym1 l) l = LeqSym2 l l + instance SuppressUnusedWarnings LeqSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) LeqSym0KindInference GHC.Tuple.()) + data LeqSym0 (l :: TyFun Nat (TyFun Nat Bool -> GHC.Types.Type)) + = forall arg. KindOf (Apply LeqSym0 arg) ~ KindOf (LeqSym1 arg) => + LeqSym0KindInference + type instance Apply LeqSym0 l = LeqSym1 l + type InsertSym2 (t :: Nat) (t :: [Nat]) = Insert t t + instance SuppressUnusedWarnings InsertSym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) InsertSym1KindInference GHC.Tuple.()) + data InsertSym1 (l :: Nat) (l :: TyFun [Nat] [Nat]) + = forall arg. KindOf (Apply (InsertSym1 l) arg) ~ KindOf (InsertSym2 l arg) => + InsertSym1KindInference + type instance Apply (InsertSym1 l) l = InsertSym2 l l + instance SuppressUnusedWarnings InsertSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) InsertSym0KindInference GHC.Tuple.()) + data InsertSym0 (l :: TyFun Nat (TyFun [Nat] [Nat] + -> GHC.Types.Type)) + = forall arg. KindOf (Apply InsertSym0 arg) ~ KindOf (InsertSym1 arg) => + InsertSym0KindInference + type instance Apply InsertSym0 l = InsertSym1 l + type InsertionSortSym1 (t :: [Nat]) = InsertionSort t + instance SuppressUnusedWarnings InsertionSortSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) InsertionSortSym0KindInference GHC.Tuple.()) + data InsertionSortSym0 (l :: TyFun [Nat] [Nat]) + = forall arg. KindOf (Apply InsertionSortSym0 arg) ~ KindOf (InsertionSortSym1 arg) => + InsertionSortSym0KindInference + type instance Apply InsertionSortSym0 l = InsertionSortSym1 l + type family Leq (a :: Nat) (a :: Nat) :: Bool where + Leq Zero _z_0123456789 = TrueSym0 + Leq (Succ _z_0123456789) 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_0123456789 n h t (Let0123456789Scrutinee_0123456789Sym3 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 _s_z_0123456789 + = let + lambda :: + forall _z_0123456789. + (t ~ ZeroSym0, t ~ _z_0123456789) => + Sing _z_0123456789 -> Sing (Apply (Apply LeqSym0 t) t :: Bool) + lambda _z_0123456789 = STrue + in lambda _s_z_0123456789 + sLeq (SSucc _s_z_0123456789) SZero + = let + lambda :: + forall _z_0123456789. + (t ~ Apply SuccSym0 _z_0123456789, t ~ ZeroSym0) => + Sing _z_0123456789 -> Sing (Apply (Apply LeqSym0 t) t :: Bool) + lambda _z_0123456789 = SFalse + in lambda _s_z_0123456789 + sLeq (SSucc sA) (SSucc sB) + = let + lambda :: + forall a b. + (t ~ Apply SuccSym0 a, t ~ Apply SuccSym0 b) => + Sing a -> Sing b -> Sing (Apply (Apply LeqSym0 t) t :: Bool) + lambda a b + = applySing + (applySing (singFun2 (Proxy :: Proxy LeqSym0) sLeq) a) b + in lambda sA sB + sInsert sN SNil + = let + lambda :: + forall n. + (t ~ n, t ~ '[]) => + Sing n -> Sing (Apply (Apply InsertSym0 t) t :: [Nat]) + lambda n + = applySing + (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) n) SNil + in lambda sN + sInsert sN (SCons sH sT) + = let + lambda :: + forall n h t. + (t ~ n, t ~ Apply (Apply (:$) h) t) => + Sing n + -> Sing h -> Sing t -> Sing (Apply (Apply InsertSym0 t) t :: [Nat]) + lambda n h t + = let + sScrutinee_0123456789 :: + Sing (Let0123456789Scrutinee_0123456789Sym3 n h t) + sScrutinee_0123456789 + = applySing + (applySing (singFun2 (Proxy :: Proxy LeqSym0) sLeq) n) h + in case sScrutinee_0123456789 of { + STrue + -> let + lambda :: + TrueSym0 ~ Let0123456789Scrutinee_0123456789Sym3 n h t => + Sing (Case_0123456789 n h t TrueSym0 :: [Nat]) + lambda + = applySing + (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) n) + (applySing (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) h) t) + in lambda + SFalse + -> let + lambda :: + FalseSym0 ~ Let0123456789Scrutinee_0123456789Sym3 n h t => + Sing (Case_0123456789 n h t FalseSym0 :: [Nat]) + lambda + = applySing + (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) h) + (applySing + (applySing (singFun2 (Proxy :: Proxy InsertSym0) sInsert) n) t) + in lambda } :: + Sing (Case_0123456789 n h t (Let0123456789Scrutinee_0123456789Sym3 n h t) :: [Nat]) + in lambda sN sH sT + sInsertionSort SNil + = let + lambda :: t ~ '[] => Sing (Apply InsertionSortSym0 t :: [Nat]) + lambda = SNil + in lambda + sInsertionSort (SCons sH sT) + = let + lambda :: + forall h t. + t ~ Apply (Apply (:$) h) t => + Sing h -> Sing t -> Sing (Apply InsertionSortSym0 t :: [Nat]) + lambda h t + = applySing + (applySing (singFun2 (Proxy :: Proxy InsertSym0) sInsert) h) + (applySing + (singFun1 (Proxy :: Proxy InsertionSortSym0) sInsertionSort) t) + in lambda sH sT diff --git a/tests/compile-and-dump/InsertionSort/InsertionSortImp.hs b/tests/compile-and-dump/InsertionSort/InsertionSortImp.hs --- a/tests/compile-and-dump/InsertionSort/InsertionSortImp.hs +++ b/tests/compile-and-dump/InsertionSort/InsertionSortImp.hs @@ -27,10 +27,17 @@ -} -{-# LANGUAGE IncoherentInstances, ConstraintKinds #-} +{-# LANGUAGE IncoherentInstances, ConstraintKinds, CPP, TypeFamilies, + TemplateHaskell, RankNTypes, ScopedTypeVariables, GADTs, + TypeOperators, DataKinds, PolyKinds, MultiParamTypeClasses, + FlexibleContexts, FlexibleInstances, UndecidableInstances #-} module InsertionSort.InsertionSortImp where +#if __GLASGOW_HASKELL__ >= 711 +import Data.Kind (type (*)) +#endif + import Data.Singletons.Prelude import Data.Singletons.SuppressUnusedWarnings import Data.Singletons.TH @@ -124,7 +131,9 @@ -- (SSucc _, SZero) -> undefined <== IMPOSSIBLE (SSucc a', SSucc b') -> case sLeq_true__le a' b' of Dict -> Dict +#if __GLASGOW_HASKELL__ < 711 _ -> error "type checking failed" +#endif -- A lemma that states if sLeq a b is SFalse, then (b :<=: a) sLeq_false__nle :: (Leq a b ~ False) => SNat a -> SNat b -> Dict (b :<=: a) @@ -134,7 +143,9 @@ (SSucc _, SZero) -> Dict (SSucc a', SSucc b') -> case sLeq_false__nle a' b' of Dict -> Dict +#if __GLASGOW_HASKELL__ < 711 _ -> error "type checking failed" +#endif -- A lemma that states that inserting into an ascending list produces an -- ascending list @@ -148,7 +159,9 @@ SCons h _ -> case sLeq n h of -- then check if n is <= h STrue -> case sLeq_true__le n h of Dict -> Dict -- if so, we're done SFalse -> case sLeq_false__nle n h of Dict -> Dict -- if not, we're done +#if __GLASGOW_HASKELL__ < 711 _ -> error "type checking failed" +#endif AscCons -> case lst of -- Otherwise, if lst is more than one element... -- SNil -> undefined <== IMPOSSIBLE SCons h t -> case sLeq n h of -- then check if n is <= h @@ -161,8 +174,10 @@ case sLeq_true__le n h2 of Dict -> Dict SFalse -> -- otherwise, show that (Insert n t) is sorted case insert_ascending n t of Dict -> Dict -- and we're done +#if __GLASGOW_HASKELL__ < 711 _ -> error "type checking failed" _ -> error "type checking failed" +#endif -- A lemma that states that inserting n into lst produces a new list with n -- inserted into lst. diff --git a/tests/compile-and-dump/Promote/Constructors.ghc80.template b/tests/compile-and-dump/Promote/Constructors.ghc80.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Promote/Constructors.ghc80.template @@ -0,0 +1,82 @@ +Promote/Constructors.hs:(0,0)-(0,0): Splicing declarations + promote + [d| data Foo = Foo | Foo :+ Foo + data Bar = Bar Bar Bar Bar Bar Foo |] + ======> + data Foo = Foo | Foo :+ Foo + data Bar = Bar Bar Bar Bar Bar Foo + type FooSym0 = Foo + type (:+$$$) (t :: Foo) (t :: Foo) = (:+) t t + instance SuppressUnusedWarnings (:+$$) where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) (:+$$###) GHC.Tuple.()) + data (:+$$) (l :: Foo) (l :: TyFun Foo Foo) + = forall arg. KindOf (Apply ((:+$$) l) arg) ~ KindOf ((:+$$$) l arg) => + (:+$$###) + type instance Apply ((:+$$) l) l = (:+$$$) l l + instance SuppressUnusedWarnings (:+$) where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) (:+$###) GHC.Tuple.()) + data (:+$) (l :: TyFun Foo (TyFun Foo Foo -> GHC.Types.Type)) + = forall arg. KindOf (Apply (:+$) arg) ~ KindOf ((:+$$) arg) => + (:+$###) + type instance Apply (:+$) l = (:+$$) l + type BarSym5 (t :: Bar) + (t :: Bar) + (t :: Bar) + (t :: Bar) + (t :: Foo) = + Bar t t t t t + instance SuppressUnusedWarnings BarSym4 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) BarSym4KindInference GHC.Tuple.()) + data BarSym4 (l :: Bar) + (l :: Bar) + (l :: Bar) + (l :: Bar) + (l :: TyFun Foo Bar) + = forall arg. KindOf (Apply (BarSym4 l l l l) arg) ~ KindOf (BarSym5 l l l l arg) => + BarSym4KindInference + type instance Apply (BarSym4 l l l l) l = BarSym5 l l l l l + instance SuppressUnusedWarnings BarSym3 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) BarSym3KindInference GHC.Tuple.()) + data BarSym3 (l :: Bar) + (l :: Bar) + (l :: Bar) + (l :: TyFun Bar (TyFun Foo Bar -> GHC.Types.Type)) + = forall arg. KindOf (Apply (BarSym3 l l l) arg) ~ KindOf (BarSym4 l l l arg) => + BarSym3KindInference + type instance Apply (BarSym3 l l l) l = BarSym4 l l l l + instance SuppressUnusedWarnings BarSym2 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) BarSym2KindInference GHC.Tuple.()) + data BarSym2 (l :: Bar) + (l :: Bar) + (l :: TyFun Bar (TyFun Bar (TyFun Foo Bar -> GHC.Types.Type) + -> GHC.Types.Type)) + = forall arg. KindOf (Apply (BarSym2 l l) arg) ~ KindOf (BarSym3 l l arg) => + BarSym2KindInference + type instance Apply (BarSym2 l l) l = BarSym3 l l l + instance SuppressUnusedWarnings BarSym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) BarSym1KindInference GHC.Tuple.()) + data BarSym1 (l :: Bar) + (l :: TyFun Bar (TyFun Bar (TyFun Bar (TyFun Foo Bar + -> GHC.Types.Type) + -> GHC.Types.Type) + -> GHC.Types.Type)) + = forall arg. KindOf (Apply (BarSym1 l) arg) ~ KindOf (BarSym2 l arg) => + BarSym1KindInference + type instance Apply (BarSym1 l) l = BarSym2 l l + instance SuppressUnusedWarnings BarSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) BarSym0KindInference GHC.Tuple.()) + data BarSym0 (l :: TyFun Bar (TyFun Bar (TyFun Bar (TyFun Bar (TyFun Foo Bar + -> GHC.Types.Type) + -> GHC.Types.Type) + -> GHC.Types.Type) + -> GHC.Types.Type)) + = forall arg. KindOf (Apply BarSym0 arg) ~ KindOf (BarSym1 arg) => + BarSym0KindInference + type instance Apply BarSym0 l = BarSym1 l diff --git a/tests/compile-and-dump/Promote/GenDefunSymbols.ghc710.template b/tests/compile-and-dump/Promote/GenDefunSymbols.ghc710.template --- a/tests/compile-and-dump/Promote/GenDefunSymbols.ghc710.template +++ b/tests/compile-and-dump/Promote/GenDefunSymbols.ghc710.template @@ -1,21 +1,22 @@ Promote/GenDefunSymbols.hs:0:0:: Splicing declarations genDefunSymbols [''LiftMaybe, ''NatT, '':+] ======> - type LiftMaybeSym2 (t :: TyFun a b -> *) (t :: Maybe a) = + type LiftMaybeSym2 (t :: TyFun a0123456789 b0123456789 -> *) + (t :: Maybe a0123456789) = LiftMaybe t t instance SuppressUnusedWarnings LiftMaybeSym1 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) LiftMaybeSym1KindInference GHC.Tuple.()) - data LiftMaybeSym1 (l :: TyFun a b -> *) - (l :: TyFun (Maybe a) (Maybe b)) + data LiftMaybeSym1 (l :: TyFun a0123456789 b0123456789 -> *) + (l :: TyFun (Maybe a0123456789) (Maybe b0123456789)) = forall arg. Data.Singletons.KindOf (Apply (LiftMaybeSym1 l) arg) ~ Data.Singletons.KindOf (LiftMaybeSym2 l arg) => LiftMaybeSym1KindInference type instance Apply (LiftMaybeSym1 l) l = LiftMaybeSym2 l l instance SuppressUnusedWarnings LiftMaybeSym0 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) LiftMaybeSym0KindInference GHC.Tuple.()) - data LiftMaybeSym0 (l :: TyFun (TyFun a b - -> *) (TyFun (Maybe a) (Maybe b) -> *)) + data LiftMaybeSym0 (l :: TyFun (TyFun a0123456789 b0123456789 + -> *) (TyFun (Maybe a0123456789) (Maybe b0123456789) -> *)) = forall arg. Data.Singletons.KindOf (Apply LiftMaybeSym0 arg) ~ Data.Singletons.KindOf (LiftMaybeSym1 arg) => LiftMaybeSym0KindInference type instance Apply LiftMaybeSym0 l = LiftMaybeSym1 l diff --git a/tests/compile-and-dump/Promote/GenDefunSymbols.ghc80.template b/tests/compile-and-dump/Promote/GenDefunSymbols.ghc80.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Promote/GenDefunSymbols.ghc80.template @@ -0,0 +1,47 @@ +Promote/GenDefunSymbols.hs:0:0:: Splicing declarations + genDefunSymbols [''LiftMaybe, ''NatT, '':+] + ======> + type LiftMaybeSym2 (t :: TyFun a0123456789 b0123456789 -> Type) + (t :: Maybe a0123456789) = + LiftMaybe t t + instance SuppressUnusedWarnings LiftMaybeSym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) LiftMaybeSym1KindInference GHC.Tuple.()) + data LiftMaybeSym1 (l :: TyFun a0123456789 b0123456789 -> Type) + (l :: TyFun (Maybe a0123456789) (Maybe b0123456789)) + = forall arg. Data.Singletons.KindOf (Apply (LiftMaybeSym1 l) arg) ~ Data.Singletons.KindOf (LiftMaybeSym2 l arg) => + LiftMaybeSym1KindInference + type instance Apply (LiftMaybeSym1 l) l = LiftMaybeSym2 l l + instance SuppressUnusedWarnings LiftMaybeSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) LiftMaybeSym0KindInference GHC.Tuple.()) + data LiftMaybeSym0 (l :: TyFun (TyFun a0123456789 b0123456789 + -> Type) (TyFun (Maybe a0123456789) (Maybe b0123456789) + -> Type)) + = forall arg. Data.Singletons.KindOf (Apply LiftMaybeSym0 arg) ~ Data.Singletons.KindOf (LiftMaybeSym1 arg) => + LiftMaybeSym0KindInference + type instance Apply LiftMaybeSym0 l = LiftMaybeSym1 l + type ZeroSym0 = Zero + type SuccSym1 (t :: NatT) = Succ t + instance SuppressUnusedWarnings SuccSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) SuccSym0KindInference GHC.Tuple.()) + data SuccSym0 (l :: TyFun NatT NatT) + = forall arg. Data.Singletons.KindOf (Apply SuccSym0 arg) ~ Data.Singletons.KindOf (SuccSym1 arg) => + SuccSym0KindInference + type instance Apply SuccSym0 l = SuccSym1 l + type (:+$$$) (t :: Nat) (t :: Nat) = (:+) t t + instance SuppressUnusedWarnings (:+$$) where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) (:+$$###) GHC.Tuple.()) + data (:+$$) (l :: Nat) l + = forall arg. Data.Singletons.KindOf (Apply ((:+$$) l) arg) ~ Data.Singletons.KindOf ((:+$$$) l arg) => + (:+$$###) + type instance Apply ((:+$$) l) l = (:+$$$) l l + instance SuppressUnusedWarnings (:+$) where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) (:+$###) GHC.Tuple.()) + data (:+$) l + = forall arg. Data.Singletons.KindOf (Apply (:+$) arg) ~ Data.Singletons.KindOf ((:+$$) arg) => + (:+$###) + type instance Apply (:+$) l = (:+$$) l diff --git a/tests/compile-and-dump/Promote/GenDefunSymbols.hs b/tests/compile-and-dump/Promote/GenDefunSymbols.hs --- a/tests/compile-and-dump/Promote/GenDefunSymbols.hs +++ b/tests/compile-and-dump/Promote/GenDefunSymbols.hs @@ -5,7 +5,11 @@ import Data.Singletons (Apply, TyFun) import Data.Singletons.Promote import Data.Singletons.SuppressUnusedWarnings -import GHC.TypeLits +import GHC.TypeLits hiding (type (*)) + +#if __GLASGOW_HASKELL__ >= 711 +import Data.Kind +#endif type family LiftMaybe (f :: TyFun a b -> *) (x :: Maybe a) :: Maybe b where LiftMaybe f Nothing = Nothing diff --git a/tests/compile-and-dump/Promote/Newtypes.ghc80.template b/tests/compile-and-dump/Promote/Newtypes.ghc80.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Promote/Newtypes.ghc80.template @@ -0,0 +1,42 @@ +Promote/Newtypes.hs:(0,0)-(0,0): Splicing declarations + promote + [d| newtype Foo + = Foo Nat + deriving (Eq) + newtype Bar = Bar {unBar :: Nat} |] + ======> + newtype Foo + = Foo Nat + deriving (Eq) + newtype Bar = Bar {unBar :: Nat} + type UnBarSym1 (t :: Bar) = UnBar t + instance SuppressUnusedWarnings UnBarSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) UnBarSym0KindInference GHC.Tuple.()) + data UnBarSym0 (l :: TyFun Bar Nat) + = forall arg. KindOf (Apply UnBarSym0 arg) ~ KindOf (UnBarSym1 arg) => + UnBarSym0KindInference + type instance Apply UnBarSym0 l = UnBarSym1 l + type family UnBar (a :: Bar) :: Nat where + UnBar (Bar field) = field + type family Equals_0123456789 (a :: Foo) (b :: Foo) :: Bool where + Equals_0123456789 (Foo a) (Foo b) = (:==) a b + Equals_0123456789 (a :: Foo) (b :: Foo) = FalseSym0 + instance PEq (KProxy :: KProxy Foo) where + type (:==) (a :: Foo) (b :: Foo) = Equals_0123456789 a b + type FooSym1 (t :: Nat) = Foo t + instance SuppressUnusedWarnings FooSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) FooSym0KindInference GHC.Tuple.()) + data FooSym0 (l :: TyFun Nat Foo) + = forall arg. KindOf (Apply FooSym0 arg) ~ KindOf (FooSym1 arg) => + FooSym0KindInference + type instance Apply FooSym0 l = FooSym1 l + type BarSym1 (t :: Nat) = Bar t + instance SuppressUnusedWarnings BarSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) BarSym0KindInference GHC.Tuple.()) + data BarSym0 (l :: TyFun Nat Bar) + = forall arg. KindOf (Apply BarSym0 arg) ~ KindOf (BarSym1 arg) => + BarSym0KindInference + type instance Apply BarSym0 l = BarSym1 l diff --git a/tests/compile-and-dump/Promote/Pragmas.ghc80.template b/tests/compile-and-dump/Promote/Pragmas.ghc80.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Promote/Pragmas.ghc80.template @@ -0,0 +1,12 @@ +Promote/Pragmas.hs:(0,0)-(0,0): Splicing declarations + promote + [d| {-# INLINE foo #-} + foo :: Bool + foo = True |] + ======> + {-# INLINE foo #-} + foo :: Bool + foo = True + type FooSym0 = Foo + type family Foo :: Bool where + Foo = TrueSym0 diff --git a/tests/compile-and-dump/Promote/Prelude.ghc80.template b/tests/compile-and-dump/Promote/Prelude.ghc80.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Promote/Prelude.ghc80.template @@ -0,0 +1,17 @@ +Promote/Prelude.hs:(0,0)-(0,0): Splicing declarations + promoteOnly + [d| odd :: Nat -> Bool + odd 0 = False + odd n = not . odd $ n - 1 |] + ======> + type OddSym1 (t :: Nat) = Odd t + instance SuppressUnusedWarnings OddSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) OddSym0KindInference GHC.Tuple.()) + data OddSym0 (l :: TyFun Nat Bool) + = forall arg. Data.Singletons.KindOf (Apply OddSym0 arg) ~ Data.Singletons.KindOf (OddSym1 arg) => + OddSym0KindInference + type instance Apply OddSym0 l = OddSym1 l + type family Odd (a :: Nat) :: Bool where + Odd 0 = FalseSym0 + Odd n = Apply (Apply ($$) (Apply (Apply (:.$) NotSym0) OddSym0)) (Apply (Apply (:-$) n) (FromInteger 1)) diff --git a/tests/compile-and-dump/Singletons/AsPattern.ghc710.template b/tests/compile-and-dump/Singletons/AsPattern.ghc710.template --- a/tests/compile-and-dump/Singletons/AsPattern.ghc710.template +++ b/tests/compile-and-dump/Singletons/AsPattern.ghc710.template @@ -226,7 +226,7 @@ Sing t -> Sing (Apply MaybePlusSym0 t :: Maybe Nat) sFoo SNil = let - lambda :: t ~ '[] => Sing (Apply FooSym0 '[] :: [Nat]) + lambda :: t ~ '[] => Sing (Apply FooSym0 t :: [Nat]) lambda = let sP :: Sing Let0123456789PSym0 @@ -237,8 +237,7 @@ = let lambda :: forall wild_0123456789. t ~ Apply (Apply (:$) wild_0123456789) '[] => - Sing wild_0123456789 - -> Sing (Apply FooSym0 (Apply (Apply (:$) wild_0123456789) '[]) :: [Nat]) + Sing wild_0123456789 -> Sing (Apply FooSym0 t :: [Nat]) lambda wild_0123456789 = let sP :: Sing (Let0123456789PSym1 wild_0123456789) @@ -257,8 +256,7 @@ wild_0123456789. t ~ Apply (Apply (:$) wild_0123456789) (Apply (Apply (:$) wild_0123456789) wild_0123456789) => Sing wild_0123456789 -> Sing wild_0123456789 - -> Sing wild_0123456789 - -> Sing (Apply FooSym0 (Apply (Apply (:$) wild_0123456789) (Apply (Apply (:$) wild_0123456789) wild_0123456789)) :: [Nat]) + -> Sing wild_0123456789 -> Sing (Apply FooSym0 t :: [Nat]) lambda wild_0123456789 wild_0123456789 wild_0123456789 = let sP :: @@ -277,9 +275,7 @@ forall wild_0123456789 wild_0123456789. t ~ Apply (Apply Tuple2Sym0 wild_0123456789) wild_0123456789 => Sing wild_0123456789 - -> Sing wild_0123456789 - -> Sing (Apply TupSym0 (Apply (Apply Tuple2Sym0 wild_0123456789) wild_0123456789) :: (Nat, - Nat)) + -> Sing wild_0123456789 -> Sing (Apply TupSym0 t :: (Nat, Nat)) lambda wild_0123456789 wild_0123456789 = let sP :: Sing (Let0123456789PSym2 wild_0123456789 wild_0123456789) @@ -292,8 +288,7 @@ in lambda sWild_0123456789 sWild_0123456789 sBaz_ SNothing = let - lambda :: - t ~ NothingSym0 => Sing (Apply Baz_Sym0 NothingSym0 :: Maybe Baz) + lambda :: t ~ NothingSym0 => Sing (Apply Baz_Sym0 t :: Maybe Baz) lambda = let sP :: Sing Let0123456789PSym0 @@ -309,8 +304,7 @@ wild_0123456789. t ~ Apply JustSym0 (Apply (Apply (Apply BazSym0 wild_0123456789) wild_0123456789) wild_0123456789) => Sing wild_0123456789 -> Sing wild_0123456789 - -> Sing wild_0123456789 - -> Sing (Apply Baz_Sym0 (Apply JustSym0 (Apply (Apply (Apply BazSym0 wild_0123456789) wild_0123456789) wild_0123456789)) :: Maybe Baz) + -> Sing wild_0123456789 -> Sing (Apply Baz_Sym0 t :: Maybe Baz) lambda wild_0123456789 wild_0123456789 wild_0123456789 = let sP :: @@ -330,8 +324,7 @@ = let lambda :: forall wild_0123456789. t ~ Apply JustSym0 wild_0123456789 => - Sing wild_0123456789 - -> Sing (Apply BarSym0 (Apply JustSym0 wild_0123456789) :: Maybe Nat) + Sing wild_0123456789 -> Sing (Apply BarSym0 t :: Maybe Nat) lambda wild_0123456789 = let sX :: Sing (Let0123456789XSym1 wild_0123456789) @@ -342,16 +335,14 @@ in lambda sWild_0123456789 sBar SNothing = let - lambda :: - t ~ NothingSym0 => Sing (Apply BarSym0 NothingSym0 :: Maybe Nat) + lambda :: t ~ NothingSym0 => Sing (Apply BarSym0 t :: Maybe Nat) lambda = SNothing in lambda sMaybePlus (SJust sN) = let lambda :: forall n. t ~ Apply JustSym0 n => - Sing n - -> Sing (Apply MaybePlusSym0 (Apply JustSym0 n) :: Maybe Nat) + Sing n -> Sing (Apply MaybePlusSym0 t :: Maybe Nat) lambda n = applySing (singFun1 (Proxy :: Proxy JustSym0) SJust) @@ -364,8 +355,7 @@ sMaybePlus SNothing = let lambda :: - t ~ NothingSym0 => - Sing (Apply MaybePlusSym0 NothingSym0 :: Maybe Nat) + t ~ NothingSym0 => Sing (Apply MaybePlusSym0 t :: Maybe Nat) lambda = let sP :: Sing Let0123456789PSym0 diff --git a/tests/compile-and-dump/Singletons/AsPattern.ghc80.template b/tests/compile-and-dump/Singletons/AsPattern.ghc80.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/AsPattern.ghc80.template @@ -0,0 +1,387 @@ +Singletons/AsPattern.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| maybePlus :: Maybe Nat -> Maybe Nat + maybePlus (Just n) = Just (plus (Succ Zero) n) + maybePlus p@Nothing = p + bar :: Maybe Nat -> Maybe Nat + bar x@(Just _) = x + bar Nothing = Nothing + baz_ :: Maybe Baz -> Maybe Baz + baz_ p@Nothing = p + baz_ p@(Just (Baz _ _ _)) = p + tup :: (Nat, Nat) -> (Nat, Nat) + tup p@(_, _) = p + foo :: [Nat] -> [Nat] + foo p@[] = p + foo p@[_] = p + foo p@(_ : _ : _) = p + + data Baz = Baz Nat Nat Nat |] + ======> + maybePlus :: Maybe Nat -> Maybe Nat + maybePlus (Just n) = Just (plus (Succ Zero) n) + maybePlus p@Nothing = p + bar :: Maybe Nat -> Maybe Nat + bar x@(Just _) = x + bar Nothing = Nothing + data Baz = Baz Nat Nat Nat + baz_ :: Maybe Baz -> Maybe Baz + baz_ p@Nothing = p + baz_ p@(Just (Baz _ _ _)) = p + tup :: (Nat, Nat) -> (Nat, Nat) + tup p@(_, _) = p + foo :: [Nat] -> [Nat] + foo p@GHC.Types.[] = p + foo p@[_] = p + foo p@(_ GHC.Types.: (_ GHC.Types.: _)) = p + type BazSym3 (t :: Nat) (t :: Nat) (t :: Nat) = Baz t t t + instance SuppressUnusedWarnings BazSym2 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) BazSym2KindInference GHC.Tuple.()) + data BazSym2 (l :: Nat) (l :: Nat) (l :: TyFun Nat Baz) + = forall arg. KindOf (Apply (BazSym2 l l) arg) ~ KindOf (BazSym3 l l arg) => + BazSym2KindInference + type instance Apply (BazSym2 l l) l = BazSym3 l l l + instance SuppressUnusedWarnings BazSym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) BazSym1KindInference GHC.Tuple.()) + data BazSym1 (l :: Nat) + (l :: TyFun Nat (TyFun Nat Baz -> GHC.Types.Type)) + = forall arg. KindOf (Apply (BazSym1 l) arg) ~ KindOf (BazSym2 l arg) => + BazSym1KindInference + type instance Apply (BazSym1 l) l = BazSym2 l l + instance SuppressUnusedWarnings BazSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) BazSym0KindInference GHC.Tuple.()) + data BazSym0 (l :: TyFun Nat (TyFun Nat (TyFun Nat Baz + -> GHC.Types.Type) + -> GHC.Types.Type)) + = forall arg. KindOf (Apply BazSym0 arg) ~ KindOf (BazSym1 arg) => + BazSym0KindInference + type instance Apply BazSym0 l = BazSym1 l + type Let0123456789PSym0 = Let0123456789P + type family Let0123456789P where + Let0123456789P = '[] + type Let0123456789PSym1 t = Let0123456789P t + instance SuppressUnusedWarnings Let0123456789PSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Let0123456789PSym0KindInference GHC.Tuple.()) + data Let0123456789PSym0 l + = forall arg. KindOf (Apply Let0123456789PSym0 arg) ~ KindOf (Let0123456789PSym1 arg) => + Let0123456789PSym0KindInference + type instance Apply Let0123456789PSym0 l = Let0123456789PSym1 l + type family Let0123456789P wild_0123456789 where + Let0123456789P wild_0123456789 = Apply (Apply (:$) wild_0123456789) '[] + type Let0123456789PSym3 t t t = Let0123456789P t t t + instance SuppressUnusedWarnings Let0123456789PSym2 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Let0123456789PSym2KindInference GHC.Tuple.()) + data Let0123456789PSym2 l l l + = forall arg. KindOf (Apply (Let0123456789PSym2 l l) arg) ~ KindOf (Let0123456789PSym3 l l arg) => + Let0123456789PSym2KindInference + type instance Apply (Let0123456789PSym2 l l) l = Let0123456789PSym3 l l l + instance SuppressUnusedWarnings Let0123456789PSym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Let0123456789PSym1KindInference GHC.Tuple.()) + data Let0123456789PSym1 l l + = forall arg. KindOf (Apply (Let0123456789PSym1 l) arg) ~ KindOf (Let0123456789PSym2 l arg) => + Let0123456789PSym1KindInference + type instance Apply (Let0123456789PSym1 l) l = Let0123456789PSym2 l l + instance SuppressUnusedWarnings Let0123456789PSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Let0123456789PSym0KindInference GHC.Tuple.()) + data Let0123456789PSym0 l + = forall arg. KindOf (Apply Let0123456789PSym0 arg) ~ KindOf (Let0123456789PSym1 arg) => + Let0123456789PSym0KindInference + type instance Apply Let0123456789PSym0 l = Let0123456789PSym1 l + type family Let0123456789P wild_0123456789 + wild_0123456789 + wild_0123456789 where + Let0123456789P wild_0123456789 wild_0123456789 wild_0123456789 = Apply (Apply (:$) wild_0123456789) (Apply (Apply (:$) wild_0123456789) wild_0123456789) + type Let0123456789PSym2 t t = Let0123456789P t t + instance SuppressUnusedWarnings Let0123456789PSym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Let0123456789PSym1KindInference GHC.Tuple.()) + data Let0123456789PSym1 l l + = forall arg. KindOf (Apply (Let0123456789PSym1 l) arg) ~ KindOf (Let0123456789PSym2 l arg) => + Let0123456789PSym1KindInference + type instance Apply (Let0123456789PSym1 l) l = Let0123456789PSym2 l l + instance SuppressUnusedWarnings Let0123456789PSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Let0123456789PSym0KindInference GHC.Tuple.()) + data Let0123456789PSym0 l + = forall arg. KindOf (Apply Let0123456789PSym0 arg) ~ KindOf (Let0123456789PSym1 arg) => + Let0123456789PSym0KindInference + type instance Apply Let0123456789PSym0 l = Let0123456789PSym1 l + type family Let0123456789P wild_0123456789 wild_0123456789 where + Let0123456789P wild_0123456789 wild_0123456789 = Apply (Apply Tuple2Sym0 wild_0123456789) wild_0123456789 + type Let0123456789PSym0 = Let0123456789P + type family Let0123456789P where + Let0123456789P = NothingSym0 + type Let0123456789PSym3 t t t = Let0123456789P t t t + instance SuppressUnusedWarnings Let0123456789PSym2 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Let0123456789PSym2KindInference GHC.Tuple.()) + data Let0123456789PSym2 l l l + = forall arg. KindOf (Apply (Let0123456789PSym2 l l) arg) ~ KindOf (Let0123456789PSym3 l l arg) => + Let0123456789PSym2KindInference + type instance Apply (Let0123456789PSym2 l l) l = Let0123456789PSym3 l l l + instance SuppressUnusedWarnings Let0123456789PSym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Let0123456789PSym1KindInference GHC.Tuple.()) + data Let0123456789PSym1 l l + = forall arg. KindOf (Apply (Let0123456789PSym1 l) arg) ~ KindOf (Let0123456789PSym2 l arg) => + Let0123456789PSym1KindInference + type instance Apply (Let0123456789PSym1 l) l = Let0123456789PSym2 l l + instance SuppressUnusedWarnings Let0123456789PSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Let0123456789PSym0KindInference GHC.Tuple.()) + data Let0123456789PSym0 l + = forall arg. KindOf (Apply Let0123456789PSym0 arg) ~ KindOf (Let0123456789PSym1 arg) => + Let0123456789PSym0KindInference + type instance Apply Let0123456789PSym0 l = Let0123456789PSym1 l + type family Let0123456789P wild_0123456789 + wild_0123456789 + wild_0123456789 where + Let0123456789P wild_0123456789 wild_0123456789 wild_0123456789 = Apply JustSym0 (Apply (Apply (Apply BazSym0 wild_0123456789) wild_0123456789) wild_0123456789) + type Let0123456789XSym1 t = Let0123456789X t + instance SuppressUnusedWarnings Let0123456789XSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Let0123456789XSym0KindInference GHC.Tuple.()) + data Let0123456789XSym0 l + = forall arg. KindOf (Apply Let0123456789XSym0 arg) ~ KindOf (Let0123456789XSym1 arg) => + Let0123456789XSym0KindInference + type instance Apply Let0123456789XSym0 l = Let0123456789XSym1 l + type family Let0123456789X wild_0123456789 where + Let0123456789X wild_0123456789 = Apply JustSym0 wild_0123456789 + type Let0123456789PSym0 = Let0123456789P + type family Let0123456789P where + Let0123456789P = NothingSym0 + type FooSym1 (t :: [Nat]) = Foo t + instance SuppressUnusedWarnings FooSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) FooSym0KindInference GHC.Tuple.()) + data FooSym0 (l :: TyFun [Nat] [Nat]) + = forall arg. KindOf (Apply FooSym0 arg) ~ KindOf (FooSym1 arg) => + FooSym0KindInference + type instance Apply FooSym0 l = FooSym1 l + type TupSym1 (t :: (Nat, Nat)) = Tup t + instance SuppressUnusedWarnings TupSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) TupSym0KindInference GHC.Tuple.()) + data TupSym0 (l :: TyFun (Nat, Nat) (Nat, Nat)) + = forall arg. KindOf (Apply TupSym0 arg) ~ KindOf (TupSym1 arg) => + TupSym0KindInference + type instance Apply TupSym0 l = TupSym1 l + type Baz_Sym1 (t :: Maybe Baz) = Baz_ t + instance SuppressUnusedWarnings Baz_Sym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Baz_Sym0KindInference GHC.Tuple.()) + data Baz_Sym0 (l :: TyFun (Maybe Baz) (Maybe Baz)) + = forall arg. KindOf (Apply Baz_Sym0 arg) ~ KindOf (Baz_Sym1 arg) => + Baz_Sym0KindInference + type instance Apply Baz_Sym0 l = Baz_Sym1 l + type BarSym1 (t :: Maybe Nat) = Bar t + instance SuppressUnusedWarnings BarSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) BarSym0KindInference GHC.Tuple.()) + data BarSym0 (l :: TyFun (Maybe Nat) (Maybe Nat)) + = forall arg. KindOf (Apply BarSym0 arg) ~ KindOf (BarSym1 arg) => + BarSym0KindInference + type instance Apply BarSym0 l = BarSym1 l + type MaybePlusSym1 (t :: Maybe Nat) = MaybePlus t + instance SuppressUnusedWarnings MaybePlusSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) MaybePlusSym0KindInference GHC.Tuple.()) + data MaybePlusSym0 (l :: TyFun (Maybe Nat) (Maybe Nat)) + = forall arg. KindOf (Apply MaybePlusSym0 arg) ~ KindOf (MaybePlusSym1 arg) => + MaybePlusSym0KindInference + type instance Apply MaybePlusSym0 l = MaybePlusSym1 l + type family Foo (a :: [Nat]) :: [Nat] where + Foo '[] = Let0123456789PSym0 + Foo '[wild_0123456789] = Let0123456789PSym1 wild_0123456789 + Foo ((:) wild_0123456789 ((:) wild_0123456789 wild_0123456789)) = Let0123456789PSym3 wild_0123456789 wild_0123456789 wild_0123456789 + type family Tup (a :: (Nat, Nat)) :: (Nat, Nat) where + Tup '(wild_0123456789, + wild_0123456789) = Let0123456789PSym2 wild_0123456789 wild_0123456789 + type family Baz_ (a :: Maybe Baz) :: Maybe Baz where + Baz_ Nothing = Let0123456789PSym0 + Baz_ (Just (Baz wild_0123456789 wild_0123456789 wild_0123456789)) = Let0123456789PSym3 wild_0123456789 wild_0123456789 wild_0123456789 + type family Bar (a :: Maybe Nat) :: Maybe Nat where + Bar (Just wild_0123456789) = Let0123456789XSym1 wild_0123456789 + Bar Nothing = NothingSym0 + type family MaybePlus (a :: Maybe Nat) :: Maybe Nat where + MaybePlus (Just n) = Apply JustSym0 (Apply (Apply PlusSym0 (Apply SuccSym0 ZeroSym0)) n) + MaybePlus Nothing = Let0123456789PSym0 + sFoo :: + forall (t :: [Nat]). Sing t -> Sing (Apply FooSym0 t :: [Nat]) + sTup :: + forall (t :: (Nat, Nat)). + Sing t -> Sing (Apply TupSym0 t :: (Nat, Nat)) + sBaz_ :: + forall (t :: Maybe Baz). + Sing t -> Sing (Apply Baz_Sym0 t :: Maybe Baz) + sBar :: + forall (t :: Maybe Nat). + Sing t -> Sing (Apply BarSym0 t :: Maybe Nat) + sMaybePlus :: + forall (t :: Maybe Nat). + Sing t -> Sing (Apply MaybePlusSym0 t :: Maybe Nat) + sFoo SNil + = let + lambda :: t ~ '[] => Sing (Apply FooSym0 t :: [Nat]) + lambda + = let + sP :: Sing Let0123456789PSym0 + sP = SNil + in sP + in lambda + sFoo (SCons sWild_0123456789 SNil) + = let + lambda :: + forall wild_0123456789. + t ~ Apply (Apply (:$) wild_0123456789) '[] => + Sing wild_0123456789 -> Sing (Apply FooSym0 t :: [Nat]) + lambda wild_0123456789 + = let + sP :: Sing (Let0123456789PSym1 wild_0123456789) + sP + = applySing + (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) wild_0123456789) + SNil + in sP + in lambda sWild_0123456789 + sFoo + (SCons sWild_0123456789 (SCons sWild_0123456789 sWild_0123456789)) + = let + lambda :: + forall wild_0123456789 wild_0123456789 wild_0123456789. + t ~ Apply (Apply (:$) wild_0123456789) (Apply (Apply (:$) wild_0123456789) wild_0123456789) => + Sing wild_0123456789 + -> Sing wild_0123456789 + -> Sing wild_0123456789 -> Sing (Apply FooSym0 t :: [Nat]) + lambda wild_0123456789 wild_0123456789 wild_0123456789 + = let + sP :: + Sing (Let0123456789PSym3 wild_0123456789 wild_0123456789 wild_0123456789) + sP + = applySing + (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) wild_0123456789) + (applySing + (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) wild_0123456789) + wild_0123456789) + in sP + in lambda sWild_0123456789 sWild_0123456789 sWild_0123456789 + sTup (STuple2 sWild_0123456789 sWild_0123456789) + = let + lambda :: + forall wild_0123456789 wild_0123456789. + t ~ Apply (Apply Tuple2Sym0 wild_0123456789) wild_0123456789 => + Sing wild_0123456789 + -> Sing wild_0123456789 -> Sing (Apply TupSym0 t :: (Nat, Nat)) + lambda wild_0123456789 wild_0123456789 + = let + sP :: Sing (Let0123456789PSym2 wild_0123456789 wild_0123456789) + sP + = applySing + (applySing + (singFun2 (Proxy :: Proxy Tuple2Sym0) STuple2) wild_0123456789) + wild_0123456789 + in sP + in lambda sWild_0123456789 sWild_0123456789 + sBaz_ SNothing + = let + lambda :: t ~ NothingSym0 => Sing (Apply Baz_Sym0 t :: Maybe Baz) + lambda + = let + sP :: Sing Let0123456789PSym0 + sP = SNothing + in sP + in lambda + sBaz_ + (SJust (SBaz sWild_0123456789 sWild_0123456789 sWild_0123456789)) + = let + lambda :: + forall wild_0123456789 wild_0123456789 wild_0123456789. + t ~ Apply JustSym0 (Apply (Apply (Apply BazSym0 wild_0123456789) wild_0123456789) wild_0123456789) => + Sing wild_0123456789 + -> Sing wild_0123456789 + -> Sing wild_0123456789 -> Sing (Apply Baz_Sym0 t :: Maybe Baz) + lambda wild_0123456789 wild_0123456789 wild_0123456789 + = let + sP :: + Sing (Let0123456789PSym3 wild_0123456789 wild_0123456789 wild_0123456789) + sP + = applySing + (singFun1 (Proxy :: Proxy JustSym0) SJust) + (applySing + (applySing + (applySing + (singFun3 (Proxy :: Proxy BazSym0) SBaz) wild_0123456789) + wild_0123456789) + wild_0123456789) + in sP + in lambda sWild_0123456789 sWild_0123456789 sWild_0123456789 + sBar (SJust sWild_0123456789) + = let + lambda :: + forall wild_0123456789. + t ~ Apply JustSym0 wild_0123456789 => + Sing wild_0123456789 -> Sing (Apply BarSym0 t :: Maybe Nat) + lambda wild_0123456789 + = let + sX :: Sing (Let0123456789XSym1 wild_0123456789) + sX + = applySing + (singFun1 (Proxy :: Proxy JustSym0) SJust) wild_0123456789 + in sX + in lambda sWild_0123456789 + sBar SNothing + = let + lambda :: t ~ NothingSym0 => Sing (Apply BarSym0 t :: Maybe Nat) + lambda = SNothing + in lambda + sMaybePlus (SJust sN) + = let + lambda :: + forall n. + t ~ Apply JustSym0 n => + Sing n -> Sing (Apply MaybePlusSym0 t :: Maybe Nat) + lambda n + = applySing + (singFun1 (Proxy :: Proxy JustSym0) SJust) + (applySing + (applySing + (singFun2 (Proxy :: Proxy PlusSym0) sPlus) + (applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) SZero)) + n) + in lambda sN + sMaybePlus SNothing + = let + lambda :: + t ~ NothingSym0 => Sing (Apply MaybePlusSym0 t :: Maybe Nat) + lambda + = let + sP :: Sing Let0123456789PSym0 + sP = SNothing + in sP + in lambda + data instance Sing (z :: Baz) + = forall (n :: Nat) (n :: Nat) (n :: Nat). z ~ Baz n n n => + SBaz (Sing (n :: Nat)) (Sing (n :: Nat)) (Sing (n :: Nat)) + type SBaz = (Sing :: Baz -> GHC.Types.Type) + instance SingKind (KProxy :: KProxy Baz) where + type DemoteRep (KProxy :: KProxy Baz) = Baz + fromSing (SBaz b b b) = Baz (fromSing b) (fromSing b) (fromSing b) + toSing (Baz b b b) + = case + GHC.Tuple.(,,) + (toSing b :: SomeSing (KProxy :: KProxy Nat)) + (toSing b :: SomeSing (KProxy :: KProxy Nat)) + (toSing b :: SomeSing (KProxy :: KProxy Nat)) + of { + GHC.Tuple.(,,) (SomeSing c) (SomeSing c) (SomeSing c) + -> SomeSing (SBaz c c c) } + instance (SingI n, SingI n, SingI n) => + SingI (Baz (n :: Nat) (n :: Nat) (n :: Nat)) where + sing = SBaz sing sing sing diff --git a/tests/compile-and-dump/Singletons/BadBoundedDeriving.ghc80.template b/tests/compile-and-dump/Singletons/BadBoundedDeriving.ghc80.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/BadBoundedDeriving.ghc80.template @@ -0,0 +1,3 @@ + +Singletons/BadBoundedDeriving.hs:0:0: error: + Can't derive Bounded instance for Foo_0 a_1. diff --git a/tests/compile-and-dump/Singletons/BadEnumDeriving.ghc80.template b/tests/compile-and-dump/Singletons/BadEnumDeriving.ghc80.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/BadEnumDeriving.ghc80.template @@ -0,0 +1,3 @@ + +Singletons/BadEnumDeriving.hs:0:0: error: + Can't derive Enum instance for Foo_0 a_1. diff --git a/tests/compile-and-dump/Singletons/BoundedDeriving.ghc710.template b/tests/compile-and-dump/Singletons/BoundedDeriving.ghc710.template --- a/tests/compile-and-dump/Singletons/BoundedDeriving.ghc710.template +++ b/tests/compile-and-dump/Singletons/BoundedDeriving.ghc710.template @@ -37,11 +37,11 @@ type CSym0 = C type DSym0 = D type ESym0 = E - type Foo3Sym1 (t :: a) = Foo3 t + type Foo3Sym1 (t :: a0123456789) = Foo3 t instance SuppressUnusedWarnings Foo3Sym0 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) Foo3Sym0KindInference GHC.Tuple.()) - data Foo3Sym0 (l :: TyFun a (Foo3 a)) + data Foo3Sym0 (l :: TyFun a0123456789 (Foo3 a0123456789)) = forall arg. KindOf (Apply Foo3Sym0 arg) ~ KindOf (Foo3Sym1 arg) => Foo3Sym0KindInference type instance Apply Foo3Sym0 l = Foo3Sym1 l diff --git a/tests/compile-and-dump/Singletons/BoundedDeriving.ghc80.template b/tests/compile-and-dump/Singletons/BoundedDeriving.ghc80.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/BoundedDeriving.ghc80.template @@ -0,0 +1,265 @@ +Singletons/BoundedDeriving.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| data Foo1 + = Foo1 + deriving (Bounded) + data Foo2 + = A | B | C | D | E + deriving (Bounded) + data Foo3 a + = Foo3 a + deriving (Bounded) + data Foo4 (a :: *) (b :: *) + = Foo41 | Foo42 + deriving (Bounded) + data Pair + = Pair Bool Bool + deriving (Bounded) |] + ======> + data Foo1 + = Foo1 + deriving (Bounded) + data Foo2 + = A | B | C | D | E + deriving (Bounded) + data Foo3 a + = Foo3 a + deriving (Bounded) + data Foo4 (a :: Type) (b :: Type) + = Foo41 | Foo42 + deriving (Bounded) + data Pair + = Pair Bool Bool + deriving (Bounded) + type Foo1Sym0 = Foo1 + type ASym0 = A + type BSym0 = B + type CSym0 = C + type DSym0 = D + type ESym0 = E + type Foo3Sym1 (t :: a0123456789) = Foo3 t + instance SuppressUnusedWarnings Foo3Sym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Foo3Sym0KindInference GHC.Tuple.()) + data Foo3Sym0 (l :: TyFun a0123456789 (Foo3 a0123456789)) + = forall arg. KindOf (Apply Foo3Sym0 arg) ~ KindOf (Foo3Sym1 arg) => + Foo3Sym0KindInference + type instance Apply Foo3Sym0 l = Foo3Sym1 l + type Foo41Sym0 = Foo41 + type Foo42Sym0 = Foo42 + type PairSym2 (t :: Bool) (t :: Bool) = Pair t t + instance SuppressUnusedWarnings PairSym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) PairSym1KindInference GHC.Tuple.()) + data PairSym1 (l :: Bool) (l :: TyFun Bool Pair) + = forall arg. KindOf (Apply (PairSym1 l) arg) ~ KindOf (PairSym2 l arg) => + PairSym1KindInference + type instance Apply (PairSym1 l) l = PairSym2 l l + instance SuppressUnusedWarnings PairSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) PairSym0KindInference GHC.Tuple.()) + data PairSym0 (l :: TyFun Bool (TyFun Bool Pair -> Type)) + = forall arg. KindOf (Apply PairSym0 arg) ~ KindOf (PairSym1 arg) => + PairSym0KindInference + type instance Apply PairSym0 l = PairSym1 l + type family MinBound_0123456789 :: Foo1 where + MinBound_0123456789 = Foo1Sym0 + type MinBound_0123456789Sym0 = MinBound_0123456789 + type family MaxBound_0123456789 :: Foo1 where + MaxBound_0123456789 = Foo1Sym0 + type MaxBound_0123456789Sym0 = MaxBound_0123456789 + instance PBounded (KProxy :: KProxy Foo1) where + type MinBound = MinBound_0123456789Sym0 + type MaxBound = MaxBound_0123456789Sym0 + type family MinBound_0123456789 :: Foo2 where + MinBound_0123456789 = ASym0 + type MinBound_0123456789Sym0 = MinBound_0123456789 + type family MaxBound_0123456789 :: Foo2 where + MaxBound_0123456789 = ESym0 + type MaxBound_0123456789Sym0 = MaxBound_0123456789 + instance PBounded (KProxy :: KProxy Foo2) where + type MinBound = MinBound_0123456789Sym0 + type MaxBound = MaxBound_0123456789Sym0 + type family MinBound_0123456789 :: Foo3 a where + MinBound_0123456789 = Apply Foo3Sym0 MinBoundSym0 + type MinBound_0123456789Sym0 = MinBound_0123456789 + type family MaxBound_0123456789 :: Foo3 a where + MaxBound_0123456789 = Apply Foo3Sym0 MaxBoundSym0 + type MaxBound_0123456789Sym0 = MaxBound_0123456789 + instance PBounded (KProxy :: KProxy (Foo3 a)) where + type MinBound = MinBound_0123456789Sym0 + type MaxBound = MaxBound_0123456789Sym0 + type family MinBound_0123456789 :: Foo4 a b where + MinBound_0123456789 = Foo41Sym0 + type MinBound_0123456789Sym0 = MinBound_0123456789 + type family MaxBound_0123456789 :: Foo4 a b where + MaxBound_0123456789 = Foo42Sym0 + type MaxBound_0123456789Sym0 = MaxBound_0123456789 + instance PBounded (KProxy :: KProxy (Foo4 a b)) where + type MinBound = MinBound_0123456789Sym0 + type MaxBound = MaxBound_0123456789Sym0 + type family MinBound_0123456789 :: Pair where + MinBound_0123456789 = Apply (Apply PairSym0 MinBoundSym0) MinBoundSym0 + type MinBound_0123456789Sym0 = MinBound_0123456789 + type family MaxBound_0123456789 :: Pair where + MaxBound_0123456789 = Apply (Apply PairSym0 MaxBoundSym0) MaxBoundSym0 + type MaxBound_0123456789Sym0 = MaxBound_0123456789 + instance PBounded (KProxy :: KProxy Pair) where + type MinBound = MinBound_0123456789Sym0 + type MaxBound = MaxBound_0123456789Sym0 + data instance Sing (z :: Foo1) = z ~ Foo1 => SFoo1 + type SFoo1 = (Sing :: Foo1 -> Type) + instance SingKind (KProxy :: KProxy Foo1) where + type DemoteRep (KProxy :: KProxy Foo1) = Foo1 + fromSing SFoo1 = Foo1 + toSing Foo1 = SomeSing SFoo1 + data instance Sing (z :: Foo2) + = z ~ A => SA | + z ~ B => SB | + z ~ C => SC | + z ~ D => SD | + z ~ E => SE + type SFoo2 = (Sing :: Foo2 -> Type) + instance SingKind (KProxy :: KProxy Foo2) where + type DemoteRep (KProxy :: KProxy Foo2) = Foo2 + fromSing SA = A + fromSing SB = B + fromSing SC = C + fromSing SD = D + fromSing SE = E + toSing A = SomeSing SA + toSing B = SomeSing SB + toSing C = SomeSing SC + toSing D = SomeSing SD + toSing E = SomeSing SE + data instance Sing (z :: Foo3 a) + = forall (n :: a). z ~ Foo3 n => SFoo3 (Sing (n :: a)) + type SFoo3 = (Sing :: Foo3 a -> Type) + instance SingKind (KProxy :: KProxy a) => + SingKind (KProxy :: KProxy (Foo3 a)) where + type DemoteRep (KProxy :: KProxy (Foo3 a)) = Foo3 (DemoteRep (KProxy :: KProxy a)) + fromSing (SFoo3 b) = Foo3 (fromSing b) + toSing (Foo3 b) + = case toSing b :: SomeSing (KProxy :: KProxy a) of { + SomeSing c -> SomeSing (SFoo3 c) } + data instance Sing (z :: Foo4 a b) + = z ~ Foo41 => SFoo41 | z ~ Foo42 => SFoo42 + type SFoo4 = (Sing :: Foo4 a b -> Type) + instance (SingKind (KProxy :: KProxy a), + SingKind (KProxy :: KProxy b)) => + SingKind (KProxy :: KProxy (Foo4 a b)) where + type DemoteRep (KProxy :: KProxy (Foo4 a b)) = Foo4 (DemoteRep (KProxy :: KProxy a)) (DemoteRep (KProxy :: KProxy b)) + fromSing SFoo41 = Foo41 + fromSing SFoo42 = Foo42 + toSing Foo41 = SomeSing SFoo41 + toSing Foo42 = SomeSing SFoo42 + data instance Sing (z :: Pair) + = forall (n :: Bool) (n :: Bool). z ~ Pair n n => + SPair (Sing (n :: Bool)) (Sing (n :: Bool)) + type SPair = (Sing :: Pair -> Type) + instance SingKind (KProxy :: KProxy Pair) where + type DemoteRep (KProxy :: KProxy Pair) = Pair + fromSing (SPair b b) = Pair (fromSing b) (fromSing b) + toSing (Pair b b) + = case + GHC.Tuple.(,) + (toSing b :: SomeSing (KProxy :: KProxy Bool)) + (toSing b :: SomeSing (KProxy :: KProxy Bool)) + of { + GHC.Tuple.(,) (SomeSing c) (SomeSing c) -> SomeSing (SPair c c) } + instance SBounded (KProxy :: KProxy Foo1) where + sMinBound :: Sing (MinBoundSym0 :: Foo1) + sMaxBound :: Sing (MaxBoundSym0 :: Foo1) + sMinBound + = let + lambda :: Sing (MinBoundSym0 :: Foo1) + lambda = SFoo1 + in lambda + sMaxBound + = let + lambda :: Sing (MaxBoundSym0 :: Foo1) + lambda = SFoo1 + in lambda + instance SBounded (KProxy :: KProxy Foo2) where + sMinBound :: Sing (MinBoundSym0 :: Foo2) + sMaxBound :: Sing (MaxBoundSym0 :: Foo2) + sMinBound + = let + lambda :: Sing (MinBoundSym0 :: Foo2) + lambda = SA + in lambda + sMaxBound + = let + lambda :: Sing (MaxBoundSym0 :: Foo2) + lambda = SE + in lambda + instance SBounded (KProxy :: KProxy a) => + SBounded (KProxy :: KProxy (Foo3 a)) where + sMinBound :: Sing (MinBoundSym0 :: Foo3 a) + sMaxBound :: Sing (MaxBoundSym0 :: Foo3 a) + sMinBound + = let + lambda :: Sing (MinBoundSym0 :: Foo3 a) + lambda + = applySing (singFun1 (Proxy :: Proxy Foo3Sym0) SFoo3) sMinBound + in lambda + sMaxBound + = let + lambda :: Sing (MaxBoundSym0 :: Foo3 a) + lambda + = applySing (singFun1 (Proxy :: Proxy Foo3Sym0) SFoo3) sMaxBound + in lambda + instance SBounded (KProxy :: KProxy (Foo4 a b)) where + sMinBound :: Sing (MinBoundSym0 :: Foo4 a b) + sMaxBound :: Sing (MaxBoundSym0 :: Foo4 a b) + sMinBound + = let + lambda :: Sing (MinBoundSym0 :: Foo4 a b) + lambda = SFoo41 + in lambda + sMaxBound + = let + lambda :: Sing (MaxBoundSym0 :: Foo4 a b) + lambda = SFoo42 + in lambda + instance SBounded (KProxy :: KProxy Bool) => + SBounded (KProxy :: KProxy Pair) where + sMinBound :: Sing (MinBoundSym0 :: Pair) + sMaxBound :: Sing (MaxBoundSym0 :: Pair) + sMinBound + = let + lambda :: Sing (MinBoundSym0 :: Pair) + lambda + = applySing + (applySing (singFun2 (Proxy :: Proxy PairSym0) SPair) sMinBound) + sMinBound + in lambda + sMaxBound + = let + lambda :: Sing (MaxBoundSym0 :: Pair) + lambda + = applySing + (applySing (singFun2 (Proxy :: Proxy PairSym0) SPair) sMaxBound) + sMaxBound + in lambda + instance SingI Foo1 where + sing = SFoo1 + instance SingI A where + sing = SA + instance SingI B where + sing = SB + instance SingI C where + sing = SC + instance SingI D where + sing = SD + instance SingI E where + sing = SE + instance SingI n => SingI (Foo3 (n :: a)) where + sing = SFoo3 sing + instance SingI Foo41 where + sing = SFoo41 + instance SingI Foo42 where + sing = SFoo42 + instance (SingI n, SingI n) => + SingI (Pair (n :: Bool) (n :: Bool)) where + sing = SPair sing sing diff --git a/tests/compile-and-dump/Singletons/BoundedDeriving.hs b/tests/compile-and-dump/Singletons/BoundedDeriving.hs --- a/tests/compile-and-dump/Singletons/BoundedDeriving.hs +++ b/tests/compile-and-dump/Singletons/BoundedDeriving.hs @@ -3,6 +3,10 @@ import Data.Singletons.Prelude import Data.Singletons.TH +#if __GLASGOW_HASKELL__ >= 711 +import Data.Kind +#endif + $(singletons [d| data Foo1 = Foo1 deriving (Bounded) data Foo2 = A | B | C | D | E deriving (Bounded) diff --git a/tests/compile-and-dump/Singletons/BoxUnBox.ghc710.template b/tests/compile-and-dump/Singletons/BoxUnBox.ghc710.template --- a/tests/compile-and-dump/Singletons/BoxUnBox.ghc710.template +++ b/tests/compile-and-dump/Singletons/BoxUnBox.ghc710.template @@ -8,19 +8,19 @@ data Box a = FBox a unBox :: forall a. Box a -> a unBox (FBox a) = a - type FBoxSym1 (t :: a) = FBox t + type FBoxSym1 (t :: a0123456789) = FBox t instance SuppressUnusedWarnings FBoxSym0 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) FBoxSym0KindInference GHC.Tuple.()) - data FBoxSym0 (l :: TyFun a (Box a)) + data FBoxSym0 (l :: TyFun a0123456789 (Box a0123456789)) = forall arg. KindOf (Apply FBoxSym0 arg) ~ KindOf (FBoxSym1 arg) => FBoxSym0KindInference type instance Apply FBoxSym0 l = FBoxSym1 l - type UnBoxSym1 (t :: Box a) = UnBox t + type UnBoxSym1 (t :: Box a0123456789) = UnBox t instance SuppressUnusedWarnings UnBoxSym0 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) UnBoxSym0KindInference GHC.Tuple.()) - data UnBoxSym0 (l :: TyFun (Box a) a) + data UnBoxSym0 (l :: TyFun (Box a0123456789) a0123456789) = forall arg. KindOf (Apply UnBoxSym0 arg) ~ KindOf (UnBoxSym1 arg) => UnBoxSym0KindInference type instance Apply UnBoxSym0 l = UnBoxSym1 l @@ -32,7 +32,7 @@ = let lambda :: forall a. t ~ Apply FBoxSym0 a => - Sing a -> Sing (Apply UnBoxSym0 (Apply FBoxSym0 a) :: a) + Sing a -> Sing (Apply UnBoxSym0 t :: a) lambda a = a in lambda sA data instance Sing (z :: Box a) diff --git a/tests/compile-and-dump/Singletons/BoxUnBox.ghc80.template b/tests/compile-and-dump/Singletons/BoxUnBox.ghc80.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/BoxUnBox.ghc80.template @@ -0,0 +1,49 @@ +Singletons/BoxUnBox.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| unBox :: Box a -> a + unBox (FBox a) = a + + data Box a = FBox a |] + ======> + data Box a = FBox a + unBox :: forall a. Box a -> a + unBox (FBox a) = a + type FBoxSym1 (t :: a0123456789) = FBox t + instance SuppressUnusedWarnings FBoxSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) FBoxSym0KindInference GHC.Tuple.()) + data FBoxSym0 (l :: TyFun a0123456789 (Box a0123456789)) + = forall arg. KindOf (Apply FBoxSym0 arg) ~ KindOf (FBoxSym1 arg) => + FBoxSym0KindInference + type instance Apply FBoxSym0 l = FBoxSym1 l + type UnBoxSym1 (t :: Box a0123456789) = UnBox t + instance SuppressUnusedWarnings UnBoxSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) UnBoxSym0KindInference GHC.Tuple.()) + data UnBoxSym0 (l :: TyFun (Box a0123456789) a0123456789) + = forall arg. KindOf (Apply UnBoxSym0 arg) ~ KindOf (UnBoxSym1 arg) => + UnBoxSym0KindInference + type instance Apply UnBoxSym0 l = UnBoxSym1 l + type family UnBox (a :: Box a) :: a where + UnBox (FBox a) = a + sUnBox :: + forall (t :: Box a). Sing t -> Sing (Apply UnBoxSym0 t :: a) + sUnBox (SFBox sA) + = let + lambda :: + forall a. + t ~ Apply FBoxSym0 a => Sing a -> Sing (Apply UnBoxSym0 t :: a) + lambda a = a + in lambda sA + data instance Sing (z :: Box a) + = forall (n :: a). z ~ FBox n => SFBox (Sing (n :: a)) + type SBox = (Sing :: Box a -> GHC.Types.Type) + instance SingKind (KProxy :: KProxy a) => + SingKind (KProxy :: KProxy (Box a)) where + type DemoteRep (KProxy :: KProxy (Box a)) = Box (DemoteRep (KProxy :: KProxy a)) + fromSing (SFBox b) = FBox (fromSing b) + toSing (FBox b) + = case toSing b :: SomeSing (KProxy :: KProxy a) of { + SomeSing c -> SomeSing (SFBox c) } + instance SingI n => SingI (FBox (n :: a)) where + sing = SFBox sing diff --git a/tests/compile-and-dump/Singletons/CaseExpressions.ghc710.template b/tests/compile-and-dump/Singletons/CaseExpressions.ghc710.template --- a/tests/compile-and-dump/Singletons/CaseExpressions.ghc710.template +++ b/tests/compile-and-dump/Singletons/CaseExpressions.ghc710.template @@ -37,19 +37,6 @@ in z } foo5 :: forall a. a -> a foo5 x = case x of { y -> \ _ -> x y } - type Let0123456789Scrutinee_0123456789Sym1 t = - Let0123456789Scrutinee_0123456789 t - instance SuppressUnusedWarnings Let0123456789Scrutinee_0123456789Sym0 where - suppressUnusedWarnings _ - = snd - (GHC.Tuple.(,) - Let0123456789Scrutinee_0123456789Sym0KindInference GHC.Tuple.()) - data Let0123456789Scrutinee_0123456789Sym0 l - = forall arg. KindOf (Apply Let0123456789Scrutinee_0123456789Sym0 arg) ~ KindOf (Let0123456789Scrutinee_0123456789Sym1 arg) => - Let0123456789Scrutinee_0123456789Sym0KindInference - type instance Apply Let0123456789Scrutinee_0123456789Sym0 l = Let0123456789Scrutinee_0123456789Sym1 l - type family Let0123456789Scrutinee_0123456789 x where - Let0123456789Scrutinee_0123456789 x = x type family Case_0123456789 x y arg_0123456789 t where Case_0123456789 x y arg_0123456789 _z_0123456789 = x type family Lambda_0123456789 x y t where @@ -81,19 +68,6 @@ type instance Apply Lambda_0123456789Sym0 l = Lambda_0123456789Sym1 l type family Case_0123456789 x t where Case_0123456789 x y = Apply (Apply (Apply Lambda_0123456789Sym0 x) y) y - type Let0123456789Scrutinee_0123456789Sym1 t = - Let0123456789Scrutinee_0123456789 t - instance SuppressUnusedWarnings Let0123456789Scrutinee_0123456789Sym0 where - suppressUnusedWarnings _ - = snd - (GHC.Tuple.(,) - Let0123456789Scrutinee_0123456789Sym0KindInference GHC.Tuple.()) - data Let0123456789Scrutinee_0123456789Sym0 l - = forall arg. KindOf (Apply Let0123456789Scrutinee_0123456789Sym0 arg) ~ KindOf (Let0123456789Scrutinee_0123456789Sym1 arg) => - Let0123456789Scrutinee_0123456789Sym0KindInference - type instance Apply Let0123456789Scrutinee_0123456789Sym0 l = Let0123456789Scrutinee_0123456789Sym1 l - type family Let0123456789Scrutinee_0123456789 x where - Let0123456789Scrutinee_0123456789 x = x type Let0123456789ZSym2 t t = Let0123456789Z t t instance SuppressUnusedWarnings Let0123456789ZSym1 where suppressUnusedWarnings _ @@ -161,102 +135,88 @@ Let0123456789Scrutinee_0123456789 d _z_0123456789 = Apply JustSym0 d type family Case_0123456789 d _z_0123456789 t where Case_0123456789 d _z_0123456789 (Just y) = y - type Let0123456789Scrutinee_0123456789Sym2 t t = - Let0123456789Scrutinee_0123456789 t t - instance SuppressUnusedWarnings Let0123456789Scrutinee_0123456789Sym1 where - suppressUnusedWarnings _ - = snd - (GHC.Tuple.(,) - Let0123456789Scrutinee_0123456789Sym1KindInference GHC.Tuple.()) - data Let0123456789Scrutinee_0123456789Sym1 l l - = forall arg. KindOf (Apply (Let0123456789Scrutinee_0123456789Sym1 l) arg) ~ KindOf (Let0123456789Scrutinee_0123456789Sym2 l arg) => - Let0123456789Scrutinee_0123456789Sym1KindInference - type instance Apply (Let0123456789Scrutinee_0123456789Sym1 l) l = Let0123456789Scrutinee_0123456789Sym2 l l - instance SuppressUnusedWarnings Let0123456789Scrutinee_0123456789Sym0 where - suppressUnusedWarnings _ - = snd - (GHC.Tuple.(,) - Let0123456789Scrutinee_0123456789Sym0KindInference GHC.Tuple.()) - data Let0123456789Scrutinee_0123456789Sym0 l - = forall arg. KindOf (Apply Let0123456789Scrutinee_0123456789Sym0 arg) ~ KindOf (Let0123456789Scrutinee_0123456789Sym1 arg) => - Let0123456789Scrutinee_0123456789Sym0KindInference - type instance Apply Let0123456789Scrutinee_0123456789Sym0 l = Let0123456789Scrutinee_0123456789Sym1 l - type family Let0123456789Scrutinee_0123456789 d x where - Let0123456789Scrutinee_0123456789 d x = x type family Case_0123456789 d x t where Case_0123456789 d x (Just y) = y Case_0123456789 d x Nothing = d - type Foo5Sym1 (t :: a) = Foo5 t + type Foo5Sym1 (t :: a0123456789) = Foo5 t instance SuppressUnusedWarnings Foo5Sym0 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) Foo5Sym0KindInference GHC.Tuple.()) - data Foo5Sym0 (l :: TyFun a a) + data Foo5Sym0 (l :: TyFun a0123456789 a0123456789) = forall arg. KindOf (Apply Foo5Sym0 arg) ~ KindOf (Foo5Sym1 arg) => Foo5Sym0KindInference type instance Apply Foo5Sym0 l = Foo5Sym1 l - type Foo4Sym1 (t :: a) = Foo4 t + type Foo4Sym1 (t :: a0123456789) = Foo4 t instance SuppressUnusedWarnings Foo4Sym0 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) Foo4Sym0KindInference GHC.Tuple.()) - data Foo4Sym0 (l :: TyFun a a) + data Foo4Sym0 (l :: TyFun a0123456789 a0123456789) = forall arg. KindOf (Apply Foo4Sym0 arg) ~ KindOf (Foo4Sym1 arg) => Foo4Sym0KindInference type instance Apply Foo4Sym0 l = Foo4Sym1 l - type Foo3Sym2 (t :: a) (t :: b) = Foo3 t t + type Foo3Sym2 (t :: a0123456789) (t :: b0123456789) = Foo3 t t instance SuppressUnusedWarnings Foo3Sym1 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) Foo3Sym1KindInference GHC.Tuple.()) - data Foo3Sym1 (l :: a) (l :: TyFun b a) + data Foo3Sym1 (l :: a0123456789) + (l :: TyFun b0123456789 a0123456789) = forall arg. KindOf (Apply (Foo3Sym1 l) arg) ~ KindOf (Foo3Sym2 l arg) => Foo3Sym1KindInference type instance Apply (Foo3Sym1 l) l = Foo3Sym2 l l instance SuppressUnusedWarnings Foo3Sym0 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) Foo3Sym0KindInference GHC.Tuple.()) - data Foo3Sym0 (l :: TyFun a (TyFun b a -> *)) + data Foo3Sym0 (l :: TyFun a0123456789 (TyFun b0123456789 a0123456789 + -> *)) = forall arg. KindOf (Apply Foo3Sym0 arg) ~ KindOf (Foo3Sym1 arg) => Foo3Sym0KindInference type instance Apply Foo3Sym0 l = Foo3Sym1 l - type Foo2Sym2 (t :: a) (t :: Maybe a) = Foo2 t t + type Foo2Sym2 (t :: a0123456789) (t :: Maybe a0123456789) = + Foo2 t t instance SuppressUnusedWarnings Foo2Sym1 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) Foo2Sym1KindInference GHC.Tuple.()) - data Foo2Sym1 (l :: a) (l :: TyFun (Maybe a) a) + data Foo2Sym1 (l :: a0123456789) + (l :: TyFun (Maybe a0123456789) a0123456789) = forall arg. KindOf (Apply (Foo2Sym1 l) arg) ~ KindOf (Foo2Sym2 l arg) => Foo2Sym1KindInference type instance Apply (Foo2Sym1 l) l = Foo2Sym2 l l instance SuppressUnusedWarnings Foo2Sym0 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) Foo2Sym0KindInference GHC.Tuple.()) - data Foo2Sym0 (l :: TyFun a (TyFun (Maybe a) a -> *)) + data Foo2Sym0 (l :: TyFun a0123456789 (TyFun (Maybe a0123456789) a0123456789 + -> *)) = forall arg. KindOf (Apply Foo2Sym0 arg) ~ KindOf (Foo2Sym1 arg) => Foo2Sym0KindInference type instance Apply Foo2Sym0 l = Foo2Sym1 l - type Foo1Sym2 (t :: a) (t :: Maybe a) = Foo1 t t + type Foo1Sym2 (t :: a0123456789) (t :: Maybe a0123456789) = + Foo1 t t instance SuppressUnusedWarnings Foo1Sym1 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) Foo1Sym1KindInference GHC.Tuple.()) - data Foo1Sym1 (l :: a) (l :: TyFun (Maybe a) a) + data Foo1Sym1 (l :: a0123456789) + (l :: TyFun (Maybe a0123456789) a0123456789) = forall arg. KindOf (Apply (Foo1Sym1 l) arg) ~ KindOf (Foo1Sym2 l arg) => Foo1Sym1KindInference type instance Apply (Foo1Sym1 l) l = Foo1Sym2 l l instance SuppressUnusedWarnings Foo1Sym0 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) Foo1Sym0KindInference GHC.Tuple.()) - data Foo1Sym0 (l :: TyFun a (TyFun (Maybe a) a -> *)) + data Foo1Sym0 (l :: TyFun a0123456789 (TyFun (Maybe a0123456789) a0123456789 + -> *)) = forall arg. KindOf (Apply Foo1Sym0 arg) ~ KindOf (Foo1Sym1 arg) => Foo1Sym0KindInference type instance Apply Foo1Sym0 l = Foo1Sym1 l type family Foo5 (a :: a) :: a where - Foo5 x = Case_0123456789 x (Let0123456789Scrutinee_0123456789Sym1 x) + Foo5 x = Case_0123456789 x x type family Foo4 (a :: a) :: a where - Foo4 x = Case_0123456789 x (Let0123456789Scrutinee_0123456789Sym1 x) + Foo4 x = Case_0123456789 x x type family Foo3 (a :: a) (a :: b) :: a where Foo3 a b = Case_0123456789 a b (Let0123456789Scrutinee_0123456789Sym2 a b) type family Foo2 (a :: a) (a :: Maybe a) :: a where Foo2 d _z_0123456789 = Case_0123456789 d _z_0123456789 (Let0123456789Scrutinee_0123456789Sym2 d _z_0123456789) type family Foo1 (a :: a) (a :: Maybe a) :: a where - Foo1 d x = Case_0123456789 d x (Let0123456789Scrutinee_0123456789Sym2 d x) + Foo1 d x = Case_0123456789 d x x sFoo5 :: forall (t :: a). Sing t -> Sing (Apply Foo5Sym0 t :: a) sFoo4 :: forall (t :: a). Sing t -> Sing (Apply Foo4Sym0 t :: a) sFoo3 :: @@ -270,71 +230,61 @@ Sing t -> Sing t -> Sing (Apply (Apply Foo1Sym0 t) t :: a) sFoo5 sX = let - lambda :: forall x. t ~ x => Sing x -> Sing (Apply Foo5Sym0 x :: a) + lambda :: forall x. t ~ x => Sing x -> Sing (Apply Foo5Sym0 t :: a) lambda x - = let - sScrutinee_0123456789 :: - Sing (Let0123456789Scrutinee_0123456789Sym1 x) - sScrutinee_0123456789 = x - in case sScrutinee_0123456789 of { - sY - -> let - lambda :: - forall y. y ~ Let0123456789Scrutinee_0123456789Sym1 x => - Sing y -> Sing (Case_0123456789 x y) - lambda y - = applySing - (singFun1 - (Proxy :: Proxy (Apply (Apply Lambda_0123456789Sym0 x) y)) - (\ sArg_0123456789 - -> let - lambda :: - forall arg_0123456789. - Sing arg_0123456789 - -> Sing (Apply (Apply (Apply Lambda_0123456789Sym0 x) y) arg_0123456789) - lambda arg_0123456789 - = case arg_0123456789 of { - _s_z_0123456789 - -> let - lambda :: - forall _z_0123456789. _z_0123456789 ~ arg_0123456789 => - Sing _z_0123456789 - -> Sing (Case_0123456789 x y arg_0123456789 _z_0123456789) - lambda _z_0123456789 = x - in lambda _s_z_0123456789 } :: - Sing (Case_0123456789 x y arg_0123456789 arg_0123456789) - in lambda sArg_0123456789)) - y - in lambda sY } :: - Sing (Case_0123456789 x (Let0123456789Scrutinee_0123456789Sym1 x)) + = case x of { + sY + -> let + lambda :: + forall y. y ~ x => Sing y -> Sing (Case_0123456789 x y :: a) + lambda y + = applySing + (singFun1 + (Proxy :: Proxy (Apply (Apply Lambda_0123456789Sym0 x) y)) + (\ sArg_0123456789 + -> let + lambda :: + forall arg_0123456789. + Sing arg_0123456789 + -> Sing (Apply (Apply (Apply Lambda_0123456789Sym0 x) y) arg_0123456789) + lambda arg_0123456789 + = case arg_0123456789 of { + _s_z_0123456789 + -> let + lambda :: + forall _z_0123456789. _z_0123456789 ~ arg_0123456789 => + Sing _z_0123456789 + -> Sing (Case_0123456789 x y arg_0123456789 _z_0123456789) + lambda _z_0123456789 = x + in lambda _s_z_0123456789 } :: + Sing (Case_0123456789 x y arg_0123456789 arg_0123456789) + in lambda sArg_0123456789)) + y + in lambda sY } :: + Sing (Case_0123456789 x x :: a) in lambda sX sFoo4 sX = let - lambda :: forall x. t ~ x => Sing x -> Sing (Apply Foo4Sym0 x :: a) + lambda :: forall x. t ~ x => Sing x -> Sing (Apply Foo4Sym0 t :: a) lambda x - = let - sScrutinee_0123456789 :: - Sing (Let0123456789Scrutinee_0123456789Sym1 x) - sScrutinee_0123456789 = x - in case sScrutinee_0123456789 of { - sY - -> let - lambda :: - forall y. y ~ Let0123456789Scrutinee_0123456789Sym1 x => - Sing y -> Sing (Case_0123456789 x y) - lambda y - = let - sZ :: Sing (Let0123456789ZSym2 x y :: a) - sZ = y - in sZ - in lambda sY } :: - Sing (Case_0123456789 x (Let0123456789Scrutinee_0123456789Sym1 x)) + = case x of { + sY + -> let + lambda :: + forall y. y ~ x => Sing y -> Sing (Case_0123456789 x y :: a) + lambda y + = let + sZ :: Sing (Let0123456789ZSym2 x y :: a) + sZ = y + in sZ + in lambda sY } :: + Sing (Case_0123456789 x x :: a) in lambda sX sFoo3 sA sB = let lambda :: forall a b. (t ~ a, t ~ b) => - Sing a -> Sing b -> Sing (Apply (Apply Foo3Sym0 a) b :: a) + Sing a -> Sing b -> Sing (Apply (Apply Foo3Sym0 t) t :: a) lambda a b = let sScrutinee_0123456789 :: @@ -350,18 +300,17 @@ _z_0123456789. Apply (Apply Tuple2Sym0 p) _z_0123456789 ~ Let0123456789Scrutinee_0123456789Sym2 a b => Sing p -> Sing _z_0123456789 - -> Sing (Case_0123456789 a b (Apply (Apply Tuple2Sym0 p) _z_0123456789)) + -> Sing (Case_0123456789 a b (Apply (Apply Tuple2Sym0 p) _z_0123456789) :: a) lambda p _z_0123456789 = p in lambda sP _s_z_0123456789 } :: - Sing (Case_0123456789 a b (Let0123456789Scrutinee_0123456789Sym2 a b)) + Sing (Case_0123456789 a b (Let0123456789Scrutinee_0123456789Sym2 a b) :: a) in lambda sA sB sFoo2 sD _s_z_0123456789 = let lambda :: forall d _z_0123456789. (t ~ d, t ~ _z_0123456789) => Sing d - -> Sing _z_0123456789 - -> Sing (Apply (Apply Foo2Sym0 d) _z_0123456789 :: a) + -> Sing _z_0123456789 -> Sing (Apply (Apply Foo2Sym0 t) t :: a) lambda d _z_0123456789 = let sScrutinee_0123456789 :: @@ -373,35 +322,31 @@ -> let lambda :: forall y. Apply JustSym0 y ~ Let0123456789Scrutinee_0123456789Sym2 d _z_0123456789 => - Sing y -> Sing (Case_0123456789 d _z_0123456789 (Apply JustSym0 y)) + Sing y + -> Sing (Case_0123456789 d _z_0123456789 (Apply JustSym0 y) :: a) lambda y = y in lambda sY } :: - Sing (Case_0123456789 d _z_0123456789 (Let0123456789Scrutinee_0123456789Sym2 d _z_0123456789)) + Sing (Case_0123456789 d _z_0123456789 (Let0123456789Scrutinee_0123456789Sym2 d _z_0123456789) :: a) in lambda sD _s_z_0123456789 sFoo1 sD sX = let lambda :: forall d x. (t ~ d, t ~ x) => - Sing d -> Sing x -> Sing (Apply (Apply Foo1Sym0 d) x :: a) + Sing d -> Sing x -> Sing (Apply (Apply Foo1Sym0 t) t :: a) lambda d x - = let - sScrutinee_0123456789 :: - Sing (Let0123456789Scrutinee_0123456789Sym2 d x) - sScrutinee_0123456789 = x - in case sScrutinee_0123456789 of { - SJust sY - -> let - lambda :: - forall y. Apply JustSym0 y ~ Let0123456789Scrutinee_0123456789Sym2 d x => - Sing y -> Sing (Case_0123456789 d x (Apply JustSym0 y)) - lambda y = y - in lambda sY - SNothing - -> let - lambda :: - NothingSym0 ~ Let0123456789Scrutinee_0123456789Sym2 d x => - Sing (Case_0123456789 d x NothingSym0) - lambda = d - in lambda } :: - Sing (Case_0123456789 d x (Let0123456789Scrutinee_0123456789Sym2 d x)) + = case x of { + SJust sY + -> let + lambda :: + forall y. Apply JustSym0 y ~ x => + Sing y -> Sing (Case_0123456789 d x (Apply JustSym0 y) :: a) + lambda y = y + in lambda sY + SNothing + -> let + lambda :: + NothingSym0 ~ x => Sing (Case_0123456789 d x NothingSym0 :: a) + lambda = d + in lambda } :: + Sing (Case_0123456789 d x x :: a) in lambda sD sX diff --git a/tests/compile-and-dump/Singletons/CaseExpressions.ghc80.template b/tests/compile-and-dump/Singletons/CaseExpressions.ghc80.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/CaseExpressions.ghc80.template @@ -0,0 +1,358 @@ +Singletons/CaseExpressions.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| foo1 :: a -> Maybe a -> a + foo1 d x + = case x of { + Just y -> y + Nothing -> d } + foo2 :: a -> Maybe a -> a + foo2 d _ = case (Just d) of { Just y -> y } + foo3 :: a -> b -> a + foo3 a b = case (a, b) of { (p, _) -> p } + foo4 :: forall a. a -> a + foo4 x + = case x of { + y -> let + z :: a + z = y + in z } + foo5 :: a -> a + foo5 x = case x of { y -> (\ _ -> x) y } |] + ======> + foo1 :: forall a. a -> Maybe a -> a + foo1 d x + = case x of { + Just y -> y + Nothing -> d } + foo2 :: forall a. a -> Maybe a -> a + foo2 d _ = case Just d of { Just y -> y } + foo3 :: forall a b. a -> b -> a + foo3 a b = case (a, b) of { (p, _) -> p } + foo4 :: forall a. a -> a + foo4 x + = case x of { + y -> let + z :: a + z = y + in z } + foo5 :: forall a. a -> a + foo5 x = case x of { y -> (\ _ -> x) y } + type family Case_0123456789 x y arg_0123456789 t where + Case_0123456789 x y arg_0123456789 _z_0123456789 = x + type family Lambda_0123456789 x y t where + Lambda_0123456789 x y arg_0123456789 = Case_0123456789 x y arg_0123456789 arg_0123456789 + type Lambda_0123456789Sym3 t t t = Lambda_0123456789 t t t + instance SuppressUnusedWarnings Lambda_0123456789Sym2 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym2KindInference GHC.Tuple.()) + data Lambda_0123456789Sym2 l l l + = forall arg. KindOf (Apply (Lambda_0123456789Sym2 l l) arg) ~ KindOf (Lambda_0123456789Sym3 l l arg) => + Lambda_0123456789Sym2KindInference + type instance Apply (Lambda_0123456789Sym2 l l) l = Lambda_0123456789Sym3 l l l + instance SuppressUnusedWarnings Lambda_0123456789Sym1 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym1KindInference GHC.Tuple.()) + data Lambda_0123456789Sym1 l l + = forall arg. KindOf (Apply (Lambda_0123456789Sym1 l) arg) ~ KindOf (Lambda_0123456789Sym2 l arg) => + Lambda_0123456789Sym1KindInference + type instance Apply (Lambda_0123456789Sym1 l) l = Lambda_0123456789Sym2 l l + instance SuppressUnusedWarnings Lambda_0123456789Sym0 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym0KindInference GHC.Tuple.()) + data Lambda_0123456789Sym0 l + = forall arg. KindOf (Apply Lambda_0123456789Sym0 arg) ~ KindOf (Lambda_0123456789Sym1 arg) => + Lambda_0123456789Sym0KindInference + type instance Apply Lambda_0123456789Sym0 l = Lambda_0123456789Sym1 l + type family Case_0123456789 x t where + Case_0123456789 x y = Apply (Apply (Apply Lambda_0123456789Sym0 x) y) y + type Let0123456789ZSym2 t t = Let0123456789Z t t + instance SuppressUnusedWarnings Let0123456789ZSym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Let0123456789ZSym1KindInference GHC.Tuple.()) + data Let0123456789ZSym1 l l + = forall arg. KindOf (Apply (Let0123456789ZSym1 l) arg) ~ KindOf (Let0123456789ZSym2 l arg) => + Let0123456789ZSym1KindInference + type instance Apply (Let0123456789ZSym1 l) l = Let0123456789ZSym2 l l + instance SuppressUnusedWarnings Let0123456789ZSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Let0123456789ZSym0KindInference GHC.Tuple.()) + data Let0123456789ZSym0 l + = forall arg. KindOf (Apply Let0123456789ZSym0 arg) ~ KindOf (Let0123456789ZSym1 arg) => + Let0123456789ZSym0KindInference + type instance Apply Let0123456789ZSym0 l = Let0123456789ZSym1 l + type family Let0123456789Z x y :: a where + Let0123456789Z x y = y + type family Case_0123456789 x t where + Case_0123456789 x y = Let0123456789ZSym2 x y + type Let0123456789Scrutinee_0123456789Sym2 t t = + Let0123456789Scrutinee_0123456789 t t + instance SuppressUnusedWarnings Let0123456789Scrutinee_0123456789Sym1 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) + Let0123456789Scrutinee_0123456789Sym1KindInference GHC.Tuple.()) + data Let0123456789Scrutinee_0123456789Sym1 l l + = forall arg. KindOf (Apply (Let0123456789Scrutinee_0123456789Sym1 l) arg) ~ KindOf (Let0123456789Scrutinee_0123456789Sym2 l arg) => + Let0123456789Scrutinee_0123456789Sym1KindInference + type instance Apply (Let0123456789Scrutinee_0123456789Sym1 l) l = Let0123456789Scrutinee_0123456789Sym2 l l + instance SuppressUnusedWarnings Let0123456789Scrutinee_0123456789Sym0 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) + Let0123456789Scrutinee_0123456789Sym0KindInference GHC.Tuple.()) + data Let0123456789Scrutinee_0123456789Sym0 l + = forall arg. KindOf (Apply Let0123456789Scrutinee_0123456789Sym0 arg) ~ KindOf (Let0123456789Scrutinee_0123456789Sym1 arg) => + Let0123456789Scrutinee_0123456789Sym0KindInference + type instance Apply Let0123456789Scrutinee_0123456789Sym0 l = Let0123456789Scrutinee_0123456789Sym1 l + type family Let0123456789Scrutinee_0123456789 a b where + Let0123456789Scrutinee_0123456789 a b = Apply (Apply Tuple2Sym0 a) b + type family Case_0123456789 a b t where + Case_0123456789 a b '(p, _z_0123456789) = p + type Let0123456789Scrutinee_0123456789Sym2 t t = + Let0123456789Scrutinee_0123456789 t t + instance SuppressUnusedWarnings Let0123456789Scrutinee_0123456789Sym1 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) + Let0123456789Scrutinee_0123456789Sym1KindInference GHC.Tuple.()) + data Let0123456789Scrutinee_0123456789Sym1 l l + = forall arg. KindOf (Apply (Let0123456789Scrutinee_0123456789Sym1 l) arg) ~ KindOf (Let0123456789Scrutinee_0123456789Sym2 l arg) => + Let0123456789Scrutinee_0123456789Sym1KindInference + type instance Apply (Let0123456789Scrutinee_0123456789Sym1 l) l = Let0123456789Scrutinee_0123456789Sym2 l l + instance SuppressUnusedWarnings Let0123456789Scrutinee_0123456789Sym0 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) + Let0123456789Scrutinee_0123456789Sym0KindInference GHC.Tuple.()) + data Let0123456789Scrutinee_0123456789Sym0 l + = forall arg. KindOf (Apply Let0123456789Scrutinee_0123456789Sym0 arg) ~ KindOf (Let0123456789Scrutinee_0123456789Sym1 arg) => + Let0123456789Scrutinee_0123456789Sym0KindInference + type instance Apply Let0123456789Scrutinee_0123456789Sym0 l = Let0123456789Scrutinee_0123456789Sym1 l + type family Let0123456789Scrutinee_0123456789 d _z_0123456789 where + Let0123456789Scrutinee_0123456789 d _z_0123456789 = Apply JustSym0 d + type family Case_0123456789 d _z_0123456789 t where + Case_0123456789 d _z_0123456789 (Just y) = y + type family Case_0123456789 d x t where + Case_0123456789 d x (Just y) = y + Case_0123456789 d x Nothing = d + type Foo5Sym1 (t :: a0123456789) = Foo5 t + instance SuppressUnusedWarnings Foo5Sym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Foo5Sym0KindInference GHC.Tuple.()) + data Foo5Sym0 (l :: TyFun a0123456789 a0123456789) + = forall arg. KindOf (Apply Foo5Sym0 arg) ~ KindOf (Foo5Sym1 arg) => + Foo5Sym0KindInference + type instance Apply Foo5Sym0 l = Foo5Sym1 l + type Foo4Sym1 (t :: a0123456789) = Foo4 t + instance SuppressUnusedWarnings Foo4Sym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Foo4Sym0KindInference GHC.Tuple.()) + data Foo4Sym0 (l :: TyFun a0123456789 a0123456789) + = forall arg. KindOf (Apply Foo4Sym0 arg) ~ KindOf (Foo4Sym1 arg) => + Foo4Sym0KindInference + type instance Apply Foo4Sym0 l = Foo4Sym1 l + type Foo3Sym2 (t :: a0123456789) (t :: b0123456789) = Foo3 t t + instance SuppressUnusedWarnings Foo3Sym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Foo3Sym1KindInference GHC.Tuple.()) + data Foo3Sym1 (l :: a0123456789) + (l :: TyFun b0123456789 a0123456789) + = forall arg. KindOf (Apply (Foo3Sym1 l) arg) ~ KindOf (Foo3Sym2 l arg) => + Foo3Sym1KindInference + type instance Apply (Foo3Sym1 l) l = Foo3Sym2 l l + instance SuppressUnusedWarnings Foo3Sym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Foo3Sym0KindInference GHC.Tuple.()) + data Foo3Sym0 (l :: TyFun a0123456789 (TyFun b0123456789 a0123456789 + -> GHC.Types.Type)) + = forall arg. KindOf (Apply Foo3Sym0 arg) ~ KindOf (Foo3Sym1 arg) => + Foo3Sym0KindInference + type instance Apply Foo3Sym0 l = Foo3Sym1 l + type Foo2Sym2 (t :: a0123456789) (t :: Maybe a0123456789) = + Foo2 t t + instance SuppressUnusedWarnings Foo2Sym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Foo2Sym1KindInference GHC.Tuple.()) + data Foo2Sym1 (l :: a0123456789) + (l :: TyFun (Maybe a0123456789) a0123456789) + = forall arg. KindOf (Apply (Foo2Sym1 l) arg) ~ KindOf (Foo2Sym2 l arg) => + Foo2Sym1KindInference + type instance Apply (Foo2Sym1 l) l = Foo2Sym2 l l + instance SuppressUnusedWarnings Foo2Sym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Foo2Sym0KindInference GHC.Tuple.()) + data Foo2Sym0 (l :: TyFun a0123456789 (TyFun (Maybe a0123456789) a0123456789 + -> GHC.Types.Type)) + = forall arg. KindOf (Apply Foo2Sym0 arg) ~ KindOf (Foo2Sym1 arg) => + Foo2Sym0KindInference + type instance Apply Foo2Sym0 l = Foo2Sym1 l + type Foo1Sym2 (t :: a0123456789) (t :: Maybe a0123456789) = + Foo1 t t + instance SuppressUnusedWarnings Foo1Sym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Foo1Sym1KindInference GHC.Tuple.()) + data Foo1Sym1 (l :: a0123456789) + (l :: TyFun (Maybe a0123456789) a0123456789) + = forall arg. KindOf (Apply (Foo1Sym1 l) arg) ~ KindOf (Foo1Sym2 l arg) => + Foo1Sym1KindInference + type instance Apply (Foo1Sym1 l) l = Foo1Sym2 l l + instance SuppressUnusedWarnings Foo1Sym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Foo1Sym0KindInference GHC.Tuple.()) + data Foo1Sym0 (l :: TyFun a0123456789 (TyFun (Maybe a0123456789) a0123456789 + -> GHC.Types.Type)) + = forall arg. KindOf (Apply Foo1Sym0 arg) ~ KindOf (Foo1Sym1 arg) => + Foo1Sym0KindInference + type instance Apply Foo1Sym0 l = Foo1Sym1 l + type family Foo5 (a :: a) :: a where + Foo5 x = Case_0123456789 x x + type family Foo4 (a :: a) :: a where + Foo4 x = Case_0123456789 x x + type family Foo3 (a :: a) (a :: b) :: a where + Foo3 a b = Case_0123456789 a b (Let0123456789Scrutinee_0123456789Sym2 a b) + type family Foo2 (a :: a) (a :: Maybe a) :: a where + Foo2 d _z_0123456789 = Case_0123456789 d _z_0123456789 (Let0123456789Scrutinee_0123456789Sym2 d _z_0123456789) + type family Foo1 (a :: a) (a :: Maybe a) :: a where + Foo1 d x = Case_0123456789 d x x + sFoo5 :: forall (t :: a). Sing t -> Sing (Apply Foo5Sym0 t :: a) + sFoo4 :: forall (t :: a). Sing t -> Sing (Apply Foo4Sym0 t :: a) + sFoo3 :: + forall (t :: a) (t :: b). + Sing t -> Sing t -> Sing (Apply (Apply Foo3Sym0 t) t :: a) + sFoo2 :: + forall (t :: a) (t :: Maybe a). + Sing t -> Sing t -> Sing (Apply (Apply Foo2Sym0 t) t :: a) + sFoo1 :: + forall (t :: a) (t :: Maybe a). + Sing t -> Sing t -> Sing (Apply (Apply Foo1Sym0 t) t :: a) + sFoo5 sX + = let + lambda :: forall x. t ~ x => Sing x -> Sing (Apply Foo5Sym0 t :: a) + lambda x + = case x of { + sY + -> let + lambda :: + forall y. y ~ x => Sing y -> Sing (Case_0123456789 x y :: a) + lambda y + = applySing + (singFun1 + (Proxy :: Proxy (Apply (Apply Lambda_0123456789Sym0 x) y)) + (\ sArg_0123456789 + -> let + lambda :: + forall arg_0123456789. + Sing arg_0123456789 + -> Sing (Apply (Apply (Apply Lambda_0123456789Sym0 x) y) arg_0123456789) + lambda arg_0123456789 + = case arg_0123456789 of { + _s_z_0123456789 + -> let + lambda :: + forall _z_0123456789. + _z_0123456789 ~ arg_0123456789 => + Sing _z_0123456789 + -> Sing (Case_0123456789 x y arg_0123456789 _z_0123456789) + lambda _z_0123456789 = x + in lambda _s_z_0123456789 } :: + Sing (Case_0123456789 x y arg_0123456789 arg_0123456789) + in lambda sArg_0123456789)) + y + in lambda sY } :: + Sing (Case_0123456789 x x :: a) + in lambda sX + sFoo4 sX + = let + lambda :: forall x. t ~ x => Sing x -> Sing (Apply Foo4Sym0 t :: a) + lambda x + = case x of { + sY + -> let + lambda :: + forall y. y ~ x => Sing y -> Sing (Case_0123456789 x y :: a) + lambda y + = let + sZ :: Sing (Let0123456789ZSym2 x y :: a) + sZ = y + in sZ + in lambda sY } :: + Sing (Case_0123456789 x x :: a) + in lambda sX + sFoo3 sA sB + = let + lambda :: + forall a b. + (t ~ a, t ~ b) => + Sing a -> Sing b -> Sing (Apply (Apply Foo3Sym0 t) t :: a) + lambda a b + = let + sScrutinee_0123456789 :: + Sing (Let0123456789Scrutinee_0123456789Sym2 a b) + sScrutinee_0123456789 + = applySing + (applySing (singFun2 (Proxy :: Proxy Tuple2Sym0) STuple2) a) b + in case sScrutinee_0123456789 of { + STuple2 sP _s_z_0123456789 + -> let + lambda :: + forall p _z_0123456789. + Apply (Apply Tuple2Sym0 p) _z_0123456789 ~ Let0123456789Scrutinee_0123456789Sym2 a b => + Sing p + -> Sing _z_0123456789 + -> Sing (Case_0123456789 a b (Apply (Apply Tuple2Sym0 p) _z_0123456789) :: a) + lambda p _z_0123456789 = p + in lambda sP _s_z_0123456789 } :: + Sing (Case_0123456789 a b (Let0123456789Scrutinee_0123456789Sym2 a b) :: a) + in lambda sA sB + sFoo2 sD _s_z_0123456789 + = let + lambda :: + forall d _z_0123456789. + (t ~ d, t ~ _z_0123456789) => + Sing d + -> Sing _z_0123456789 -> Sing (Apply (Apply Foo2Sym0 t) t :: a) + lambda d _z_0123456789 + = let + sScrutinee_0123456789 :: + Sing (Let0123456789Scrutinee_0123456789Sym2 d _z_0123456789) + sScrutinee_0123456789 + = applySing (singFun1 (Proxy :: Proxy JustSym0) SJust) d + in case sScrutinee_0123456789 of { + SJust sY + -> let + lambda :: + forall y. + Apply JustSym0 y ~ Let0123456789Scrutinee_0123456789Sym2 d _z_0123456789 => + Sing y + -> Sing (Case_0123456789 d _z_0123456789 (Apply JustSym0 y) :: a) + lambda y = y + in lambda sY } :: + Sing (Case_0123456789 d _z_0123456789 (Let0123456789Scrutinee_0123456789Sym2 d _z_0123456789) :: a) + in lambda sD _s_z_0123456789 + sFoo1 sD sX + = let + lambda :: + forall d x. + (t ~ d, t ~ x) => + Sing d -> Sing x -> Sing (Apply (Apply Foo1Sym0 t) t :: a) + lambda d x + = case x of { + SJust sY + -> let + lambda :: + forall y. + Apply JustSym0 y ~ x => + Sing y -> Sing (Case_0123456789 d x (Apply JustSym0 y) :: a) + lambda y = y + in lambda sY + SNothing + -> let + lambda :: + NothingSym0 ~ x => Sing (Case_0123456789 d x NothingSym0 :: a) + lambda = d + in lambda } :: + Sing (Case_0123456789 d x x :: a) + in lambda sD sX diff --git a/tests/compile-and-dump/Singletons/Classes.ghc710.template b/tests/compile-and-dump/Singletons/Classes.ghc710.template --- a/tests/compile-and-dump/Singletons/Classes.ghc710.template +++ b/tests/compile-and-dump/Singletons/Classes.ghc710.template @@ -80,18 +80,20 @@ = forall arg. KindOf (Apply FooCompareSym0 arg) ~ KindOf (FooCompareSym1 arg) => FooCompareSym0KindInference type instance Apply FooCompareSym0 l = FooCompareSym1 l - type ConstSym2 (t :: a) (t :: b) = Const t t + type ConstSym2 (t :: a0123456789) (t :: b0123456789) = Const t t instance SuppressUnusedWarnings ConstSym1 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) ConstSym1KindInference GHC.Tuple.()) - data ConstSym1 (l :: a) (l :: TyFun b a) + data ConstSym1 (l :: a0123456789) + (l :: TyFun b0123456789 a0123456789) = forall arg. KindOf (Apply (ConstSym1 l) arg) ~ KindOf (ConstSym2 l arg) => ConstSym1KindInference type instance Apply (ConstSym1 l) l = ConstSym2 l l instance SuppressUnusedWarnings ConstSym0 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) ConstSym0KindInference GHC.Tuple.()) - data ConstSym0 (l :: TyFun a (TyFun b a -> *)) + data ConstSym0 (l :: TyFun a0123456789 (TyFun b0123456789 a0123456789 + -> *)) = forall arg. KindOf (Apply ConstSym0 arg) ~ KindOf (ConstSym1 arg) => ConstSym0KindInference type instance Apply ConstSym0 l = ConstSym1 l @@ -103,45 +105,51 @@ type family Const (a :: a) (a :: b) :: a where Const x _z_0123456789 = x infix 4 :<=> - type MycompareSym2 (t :: a) (t :: a) = Mycompare t t + type MycompareSym2 (t :: a0123456789) (t :: a0123456789) = + Mycompare t t instance SuppressUnusedWarnings MycompareSym1 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) MycompareSym1KindInference GHC.Tuple.()) - data MycompareSym1 (l :: a) (l :: TyFun a Ordering) + data MycompareSym1 (l :: a0123456789) + (l :: TyFun a0123456789 Ordering) = forall arg. KindOf (Apply (MycompareSym1 l) arg) ~ KindOf (MycompareSym2 l arg) => MycompareSym1KindInference type instance Apply (MycompareSym1 l) l = MycompareSym2 l l instance SuppressUnusedWarnings MycompareSym0 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) MycompareSym0KindInference GHC.Tuple.()) - data MycompareSym0 (l :: TyFun a (TyFun a Ordering -> *)) + data MycompareSym0 (l :: TyFun a0123456789 (TyFun a0123456789 Ordering + -> *)) = forall arg. KindOf (Apply MycompareSym0 arg) ~ KindOf (MycompareSym1 arg) => MycompareSym0KindInference type instance Apply MycompareSym0 l = MycompareSym1 l - type (:<=>$$$) (t :: a) (t :: a) = (:<=>) t t + type (:<=>$$$) (t :: a0123456789) (t :: a0123456789) = (:<=>) t t instance SuppressUnusedWarnings (:<=>$$) where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) (:<=>$$###) GHC.Tuple.()) - data (:<=>$$) (l :: a) (l :: TyFun a Ordering) + data (:<=>$$) (l :: a0123456789) (l :: TyFun a0123456789 Ordering) = forall arg. KindOf (Apply ((:<=>$$) l) arg) ~ KindOf ((:<=>$$$) l arg) => :<=>$$### type instance Apply ((:<=>$$) l) l = (:<=>$$$) l l instance SuppressUnusedWarnings (:<=>$) where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) (:<=>$###) GHC.Tuple.()) - data (:<=>$) (l :: TyFun a (TyFun a Ordering -> *)) + data (:<=>$) (l :: TyFun a0123456789 (TyFun a0123456789 Ordering + -> *)) = forall arg. KindOf (Apply (:<=>$) arg) ~ KindOf ((:<=>$$) arg) => :<=>$### type instance Apply (:<=>$) l = (:<=>$$) l type family TFHelper_0123456789 (a :: a) (a :: a) :: Ordering where TFHelper_0123456789 a_0123456789 a_0123456789 = Apply (Apply MycompareSym0 a_0123456789) a_0123456789 - type TFHelper_0123456789Sym2 (t :: a) (t :: a) = + type TFHelper_0123456789Sym2 (t :: a0123456789) + (t :: a0123456789) = TFHelper_0123456789 t t instance SuppressUnusedWarnings TFHelper_0123456789Sym1 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) TFHelper_0123456789Sym1KindInference GHC.Tuple.()) - data TFHelper_0123456789Sym1 (l :: a) (l :: TyFun a Ordering) + data TFHelper_0123456789Sym1 (l :: a0123456789) + (l :: TyFun a0123456789 Ordering) = forall arg. KindOf (Apply (TFHelper_0123456789Sym1 l) arg) ~ KindOf (TFHelper_0123456789Sym2 l arg) => TFHelper_0123456789Sym1KindInference type instance Apply (TFHelper_0123456789Sym1 l) l = TFHelper_0123456789Sym2 l l @@ -149,7 +157,8 @@ suppressUnusedWarnings _ = snd (GHC.Tuple.(,) TFHelper_0123456789Sym0KindInference GHC.Tuple.()) - data TFHelper_0123456789Sym0 (l :: TyFun a (TyFun a Ordering -> *)) + data TFHelper_0123456789Sym0 (l :: TyFun a0123456789 (TyFun a0123456789 Ordering + -> *)) = forall arg. KindOf (Apply TFHelper_0123456789Sym0 arg) ~ KindOf (TFHelper_0123456789Sym1 arg) => TFHelper_0123456789Sym0KindInference type instance Apply TFHelper_0123456789Sym0 l = TFHelper_0123456789Sym1 l @@ -272,28 +281,28 @@ = let lambda :: (t ~ ASym0, t ~ ASym0) => - Sing (Apply (Apply FooCompareSym0 ASym0) ASym0 :: Ordering) + Sing (Apply (Apply FooCompareSym0 t) t :: Ordering) lambda = SEQ in lambda sFooCompare SA SB = let lambda :: (t ~ ASym0, t ~ BSym0) => - Sing (Apply (Apply FooCompareSym0 ASym0) BSym0 :: Ordering) + Sing (Apply (Apply FooCompareSym0 t) t :: Ordering) lambda = SLT in lambda sFooCompare SB SB = let lambda :: (t ~ BSym0, t ~ BSym0) => - Sing (Apply (Apply FooCompareSym0 BSym0) BSym0 :: Ordering) + Sing (Apply (Apply FooCompareSym0 t) t :: Ordering) lambda = SGT in lambda sFooCompare SB SA = let lambda :: (t ~ BSym0, t ~ ASym0) => - Sing (Apply (Apply FooCompareSym0 BSym0) ASym0 :: Ordering) + Sing (Apply (Apply FooCompareSym0 t) t :: Ordering) lambda = SEQ in lambda sConst sX _s_z_0123456789 @@ -301,8 +310,7 @@ lambda :: forall x _z_0123456789. (t ~ x, t ~ _z_0123456789) => Sing x - -> Sing _z_0123456789 - -> Sing (Apply (Apply ConstSym0 x) _z_0123456789 :: a) + -> Sing _z_0123456789 -> Sing (Apply (Apply ConstSym0 t) t :: a) lambda x _z_0123456789 = x in lambda sX _s_z_0123456789 data instance Sing (z :: Foo) = z ~ A => SA | z ~ B => SB @@ -340,7 +348,7 @@ t ~ a_0123456789) => Sing a_0123456789 -> Sing a_0123456789 - -> Sing (Apply (Apply (:<=>$) a_0123456789) a_0123456789 :: Ordering) + -> Sing (Apply (Apply (:<=>$) t) t :: Ordering) lambda a_0123456789 a_0123456789 = applySing (applySing @@ -356,7 +364,7 @@ = let lambda :: (t ~ ZeroSym0, t ~ ZeroSym0) => - Sing (Apply (Apply MycompareSym0 ZeroSym0) ZeroSym0 :: Ordering) + Sing (Apply (Apply MycompareSym0 t) t :: Ordering) lambda = SEQ in lambda sMycompare SZero (SSucc _s_z_0123456789) @@ -365,7 +373,7 @@ forall _z_0123456789. (t ~ ZeroSym0, t ~ Apply SuccSym0 _z_0123456789) => Sing _z_0123456789 - -> Sing (Apply (Apply MycompareSym0 ZeroSym0) (Apply SuccSym0 _z_0123456789) :: Ordering) + -> Sing (Apply (Apply MycompareSym0 t) t :: Ordering) lambda _z_0123456789 = SLT in lambda _s_z_0123456789 sMycompare (SSucc _s_z_0123456789) SZero @@ -374,7 +382,7 @@ forall _z_0123456789. (t ~ Apply SuccSym0 _z_0123456789, t ~ ZeroSym0) => Sing _z_0123456789 - -> Sing (Apply (Apply MycompareSym0 (Apply SuccSym0 _z_0123456789)) ZeroSym0 :: Ordering) + -> Sing (Apply (Apply MycompareSym0 t) t :: Ordering) lambda _z_0123456789 = SGT in lambda _s_z_0123456789 sMycompare (SSucc sN) (SSucc sM) @@ -382,8 +390,7 @@ lambda :: forall n m. (t ~ Apply SuccSym0 n, t ~ Apply SuccSym0 m) => Sing n - -> Sing m - -> Sing (Apply (Apply MycompareSym0 (Apply SuccSym0 n)) (Apply SuccSym0 m) :: Ordering) + -> Sing m -> Sing (Apply (Apply MycompareSym0 t) t :: Ordering) lambda n m = applySing (applySing (singFun2 (Proxy :: Proxy MycompareSym0) sMycompare) m) @@ -401,7 +408,7 @@ t ~ a_0123456789) => Sing _z_0123456789 -> Sing a_0123456789 - -> Sing (Apply (Apply MycompareSym0 _z_0123456789) a_0123456789 :: Ordering) + -> Sing (Apply (Apply MycompareSym0 t) t :: Ordering) lambda _z_0123456789 a_0123456789 = applySing (applySing (singFun2 (Proxy :: Proxy ConstSym0) sConst) SEQ) @@ -419,7 +426,7 @@ t ~ a_0123456789) => Sing a_0123456789 -> Sing a_0123456789 - -> Sing (Apply (Apply MycompareSym0 a_0123456789) a_0123456789 :: Ordering) + -> Sing (Apply (Apply MycompareSym0 t) t :: Ordering) lambda a_0123456789 a_0123456789 = applySing (applySing @@ -433,26 +440,22 @@ Sing a -> Sing b -> Sing ((:==) a b) (%:==) SF SF = let - lambda :: - (a ~ FSym0, b ~ FSym0) => Sing (Apply (Apply (:==$) FSym0) FSym0) + lambda :: (a ~ FSym0, b ~ FSym0) => Sing (Apply (Apply (:==$) a) b) lambda = STrue in lambda (%:==) SG SG = let - lambda :: - (a ~ GSym0, b ~ GSym0) => Sing (Apply (Apply (:==$) GSym0) GSym0) + lambda :: (a ~ GSym0, b ~ GSym0) => Sing (Apply (Apply (:==$) a) b) lambda = STrue in lambda (%:==) SF SG = let - lambda :: - (a ~ FSym0, b ~ GSym0) => Sing (Apply (Apply (:==$) FSym0) GSym0) + lambda :: (a ~ FSym0, b ~ GSym0) => Sing (Apply (Apply (:==$) a) b) lambda = SFalse in lambda (%:==) SG SF = let - lambda :: - (a ~ GSym0, b ~ FSym0) => Sing (Apply (Apply (:==$) GSym0) FSym0) + lambda :: (a ~ GSym0, b ~ FSym0) => Sing (Apply (Apply (:==$) a) b) lambda = SFalse in lambda instance SingI A where @@ -613,7 +616,7 @@ = let lambda :: (t ~ Zero'Sym0, t ~ Zero'Sym0) => - Sing (Apply (Apply MycompareSym0 Zero'Sym0) Zero'Sym0 :: Ordering) + Sing (Apply (Apply MycompareSym0 t) t :: Ordering) lambda = SEQ in lambda sMycompare SZero' (SSucc' _s_z_0123456789) @@ -622,7 +625,7 @@ forall _z_0123456789. (t ~ Zero'Sym0, t ~ Apply Succ'Sym0 _z_0123456789) => Sing _z_0123456789 - -> Sing (Apply (Apply MycompareSym0 Zero'Sym0) (Apply Succ'Sym0 _z_0123456789) :: Ordering) + -> Sing (Apply (Apply MycompareSym0 t) t :: Ordering) lambda _z_0123456789 = SLT in lambda _s_z_0123456789 sMycompare (SSucc' _s_z_0123456789) SZero' @@ -631,7 +634,7 @@ forall _z_0123456789. (t ~ Apply Succ'Sym0 _z_0123456789, t ~ Zero'Sym0) => Sing _z_0123456789 - -> Sing (Apply (Apply MycompareSym0 (Apply Succ'Sym0 _z_0123456789)) Zero'Sym0 :: Ordering) + -> Sing (Apply (Apply MycompareSym0 t) t :: Ordering) lambda _z_0123456789 = SGT in lambda _s_z_0123456789 sMycompare (SSucc' sN) (SSucc' sM) @@ -639,8 +642,7 @@ lambda :: forall n m. (t ~ Apply Succ'Sym0 n, t ~ Apply Succ'Sym0 m) => Sing n - -> Sing m - -> Sing (Apply (Apply MycompareSym0 (Apply Succ'Sym0 n)) (Apply Succ'Sym0 m) :: Ordering) + -> Sing m -> Sing (Apply (Apply MycompareSym0 t) t :: Ordering) lambda n m = applySing (applySing (singFun2 (Proxy :: Proxy MycompareSym0) sMycompare) m) diff --git a/tests/compile-and-dump/Singletons/Classes.ghc80.template b/tests/compile-and-dump/Singletons/Classes.ghc80.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/Classes.ghc80.template @@ -0,0 +1,657 @@ +Singletons/Classes.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| infix 4 <=> + + const :: a -> b -> a + const x _ = x + fooCompare :: Foo -> Foo -> Ordering + fooCompare A A = EQ + fooCompare A B = LT + fooCompare B B = GT + fooCompare B A = EQ + + class MyOrd a where + mycompare :: a -> a -> Ordering + (<=>) :: a -> a -> Ordering + (<=>) = mycompare + infix 4 <=> + data Foo = A | B + data Foo2 = F | G + + instance Eq Foo2 where + F == F = True + G == G = True + F == G = False + G == F = False + instance MyOrd Foo where + mycompare = fooCompare + instance MyOrd () where + mycompare _ = const EQ + instance MyOrd Nat where + Zero `mycompare` Zero = EQ + Zero `mycompare` (Succ _) = LT + (Succ _) `mycompare` Zero = GT + (Succ n) `mycompare` (Succ m) = m `mycompare` n |] + ======> + const :: forall a b. a -> b -> a + const x _ = x + class MyOrd a where + mycompare :: a -> a -> Ordering + (<=>) :: a -> a -> Ordering + (<=>) = mycompare + infix 4 <=> + instance MyOrd Nat where + mycompare Zero Zero = EQ + mycompare Zero (Succ _) = LT + mycompare (Succ _) Zero = GT + mycompare (Succ n) (Succ m) = (m `mycompare` n) + instance MyOrd () where + mycompare _ = const EQ + data Foo = A | B + fooCompare :: Foo -> Foo -> Ordering + fooCompare A A = EQ + fooCompare A B = LT + fooCompare B B = GT + fooCompare B A = EQ + instance MyOrd Foo where + mycompare = fooCompare + data Foo2 = F | G + instance Eq Foo2 where + (==) F F = True + (==) G G = True + (==) F G = False + (==) G F = False + type ASym0 = A + type BSym0 = B + type FSym0 = F + type GSym0 = G + type FooCompareSym2 (t :: Foo) (t :: Foo) = FooCompare t t + instance SuppressUnusedWarnings FooCompareSym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) FooCompareSym1KindInference GHC.Tuple.()) + data FooCompareSym1 (l :: Foo) (l :: TyFun Foo Ordering) + = forall arg. KindOf (Apply (FooCompareSym1 l) arg) ~ KindOf (FooCompareSym2 l arg) => + FooCompareSym1KindInference + type instance Apply (FooCompareSym1 l) l = FooCompareSym2 l l + instance SuppressUnusedWarnings FooCompareSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) FooCompareSym0KindInference GHC.Tuple.()) + data FooCompareSym0 (l :: TyFun Foo (TyFun Foo Ordering + -> GHC.Types.Type)) + = forall arg. KindOf (Apply FooCompareSym0 arg) ~ KindOf (FooCompareSym1 arg) => + FooCompareSym0KindInference + type instance Apply FooCompareSym0 l = FooCompareSym1 l + type ConstSym2 (t :: a0123456789) (t :: b0123456789) = Const t t + instance SuppressUnusedWarnings ConstSym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) ConstSym1KindInference GHC.Tuple.()) + data ConstSym1 (l :: a0123456789) + (l :: TyFun b0123456789 a0123456789) + = forall arg. KindOf (Apply (ConstSym1 l) arg) ~ KindOf (ConstSym2 l arg) => + ConstSym1KindInference + type instance Apply (ConstSym1 l) l = ConstSym2 l l + instance SuppressUnusedWarnings ConstSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) ConstSym0KindInference GHC.Tuple.()) + data ConstSym0 (l :: TyFun a0123456789 (TyFun b0123456789 a0123456789 + -> GHC.Types.Type)) + = forall arg. KindOf (Apply ConstSym0 arg) ~ KindOf (ConstSym1 arg) => + ConstSym0KindInference + type instance Apply ConstSym0 l = ConstSym1 l + type family FooCompare (a :: Foo) (a :: Foo) :: Ordering where + FooCompare A A = EQSym0 + FooCompare A B = LTSym0 + FooCompare B B = GTSym0 + FooCompare B A = EQSym0 + type family Const (a :: a) (a :: b) :: a where + Const x _z_0123456789 = x + infix 4 :<=> + type MycompareSym2 (t :: a0123456789) (t :: a0123456789) = + Mycompare t t + instance SuppressUnusedWarnings MycompareSym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) MycompareSym1KindInference GHC.Tuple.()) + data MycompareSym1 (l :: a0123456789) + (l :: TyFun a0123456789 Ordering) + = forall arg. KindOf (Apply (MycompareSym1 l) arg) ~ KindOf (MycompareSym2 l arg) => + MycompareSym1KindInference + type instance Apply (MycompareSym1 l) l = MycompareSym2 l l + instance SuppressUnusedWarnings MycompareSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) MycompareSym0KindInference GHC.Tuple.()) + data MycompareSym0 (l :: TyFun a0123456789 (TyFun a0123456789 Ordering + -> GHC.Types.Type)) + = forall arg. KindOf (Apply MycompareSym0 arg) ~ KindOf (MycompareSym1 arg) => + MycompareSym0KindInference + type instance Apply MycompareSym0 l = MycompareSym1 l + type (:<=>$$$) (t :: a0123456789) (t :: a0123456789) = (:<=>) t t + instance SuppressUnusedWarnings (:<=>$$) where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) (:<=>$$###) GHC.Tuple.()) + data (:<=>$$) (l :: a0123456789) (l :: TyFun a0123456789 Ordering) + = forall arg. KindOf (Apply ((:<=>$$) l) arg) ~ KindOf ((:<=>$$$) l arg) => + (:<=>$$###) + type instance Apply ((:<=>$$) l) l = (:<=>$$$) l l + instance SuppressUnusedWarnings (:<=>$) where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) (:<=>$###) GHC.Tuple.()) + data (:<=>$) (l :: TyFun a0123456789 (TyFun a0123456789 Ordering + -> GHC.Types.Type)) + = forall arg. KindOf (Apply (:<=>$) arg) ~ KindOf ((:<=>$$) arg) => + (:<=>$###) + type instance Apply (:<=>$) l = (:<=>$$) l + type family TFHelper_0123456789 (a :: a) (a :: a) :: Ordering where + TFHelper_0123456789 a_0123456789 a_0123456789 = Apply (Apply MycompareSym0 a_0123456789) a_0123456789 + type TFHelper_0123456789Sym2 (t :: a0123456789) + (t :: a0123456789) = + TFHelper_0123456789 t t + instance SuppressUnusedWarnings TFHelper_0123456789Sym1 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) TFHelper_0123456789Sym1KindInference GHC.Tuple.()) + data TFHelper_0123456789Sym1 (l :: a0123456789) + (l :: TyFun a0123456789 Ordering) + = forall arg. KindOf (Apply (TFHelper_0123456789Sym1 l) arg) ~ KindOf (TFHelper_0123456789Sym2 l arg) => + TFHelper_0123456789Sym1KindInference + type instance Apply (TFHelper_0123456789Sym1 l) l = TFHelper_0123456789Sym2 l l + instance SuppressUnusedWarnings TFHelper_0123456789Sym0 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) TFHelper_0123456789Sym0KindInference GHC.Tuple.()) + data TFHelper_0123456789Sym0 (l :: TyFun a0123456789 (TyFun a0123456789 Ordering + -> GHC.Types.Type)) + = forall arg. KindOf (Apply TFHelper_0123456789Sym0 arg) ~ KindOf (TFHelper_0123456789Sym1 arg) => + TFHelper_0123456789Sym0KindInference + type instance Apply TFHelper_0123456789Sym0 l = TFHelper_0123456789Sym1 l + class kproxy ~ KProxy => PMyOrd (kproxy :: KProxy a) where + type Mycompare (arg :: a) (arg :: a) :: Ordering + type (:<=>) (arg :: a) (arg :: a) :: Ordering + type (:<=>) a a = Apply (Apply TFHelper_0123456789Sym0 a) a + type family Mycompare_0123456789 (a :: Nat) + (a :: Nat) :: Ordering where + Mycompare_0123456789 Zero Zero = EQSym0 + Mycompare_0123456789 Zero (Succ _z_0123456789) = LTSym0 + Mycompare_0123456789 (Succ _z_0123456789) Zero = GTSym0 + Mycompare_0123456789 (Succ n) (Succ m) = Apply (Apply MycompareSym0 m) n + type Mycompare_0123456789Sym2 (t :: Nat) (t :: Nat) = + Mycompare_0123456789 t t + instance SuppressUnusedWarnings Mycompare_0123456789Sym1 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Mycompare_0123456789Sym1KindInference GHC.Tuple.()) + data Mycompare_0123456789Sym1 (l :: Nat) (l :: TyFun Nat Ordering) + = forall arg. KindOf (Apply (Mycompare_0123456789Sym1 l) arg) ~ KindOf (Mycompare_0123456789Sym2 l arg) => + Mycompare_0123456789Sym1KindInference + type instance Apply (Mycompare_0123456789Sym1 l) l = Mycompare_0123456789Sym2 l l + instance SuppressUnusedWarnings Mycompare_0123456789Sym0 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Mycompare_0123456789Sym0KindInference GHC.Tuple.()) + data Mycompare_0123456789Sym0 (l :: TyFun Nat (TyFun Nat Ordering + -> GHC.Types.Type)) + = forall arg. KindOf (Apply Mycompare_0123456789Sym0 arg) ~ KindOf (Mycompare_0123456789Sym1 arg) => + Mycompare_0123456789Sym0KindInference + type instance Apply Mycompare_0123456789Sym0 l = Mycompare_0123456789Sym1 l + instance PMyOrd (KProxy :: KProxy Nat) where + type Mycompare (a :: Nat) (a :: Nat) = Apply (Apply Mycompare_0123456789Sym0 a) a + type family Mycompare_0123456789 (a :: ()) + (a :: ()) :: Ordering where + Mycompare_0123456789 _z_0123456789 a_0123456789 = Apply (Apply ConstSym0 EQSym0) a_0123456789 + type Mycompare_0123456789Sym2 (t :: ()) (t :: ()) = + Mycompare_0123456789 t t + instance SuppressUnusedWarnings Mycompare_0123456789Sym1 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Mycompare_0123456789Sym1KindInference GHC.Tuple.()) + data Mycompare_0123456789Sym1 (l :: ()) (l :: TyFun () Ordering) + = forall arg. KindOf (Apply (Mycompare_0123456789Sym1 l) arg) ~ KindOf (Mycompare_0123456789Sym2 l arg) => + Mycompare_0123456789Sym1KindInference + type instance Apply (Mycompare_0123456789Sym1 l) l = Mycompare_0123456789Sym2 l l + instance SuppressUnusedWarnings Mycompare_0123456789Sym0 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Mycompare_0123456789Sym0KindInference GHC.Tuple.()) + data Mycompare_0123456789Sym0 (l :: TyFun () (TyFun () Ordering + -> GHC.Types.Type)) + = forall arg. KindOf (Apply Mycompare_0123456789Sym0 arg) ~ KindOf (Mycompare_0123456789Sym1 arg) => + Mycompare_0123456789Sym0KindInference + type instance Apply Mycompare_0123456789Sym0 l = Mycompare_0123456789Sym1 l + instance PMyOrd (KProxy :: KProxy ()) where + type Mycompare (a :: ()) (a :: ()) = Apply (Apply Mycompare_0123456789Sym0 a) a + type family Mycompare_0123456789 (a :: Foo) + (a :: Foo) :: Ordering where + Mycompare_0123456789 a_0123456789 a_0123456789 = Apply (Apply FooCompareSym0 a_0123456789) a_0123456789 + type Mycompare_0123456789Sym2 (t :: Foo) (t :: Foo) = + Mycompare_0123456789 t t + instance SuppressUnusedWarnings Mycompare_0123456789Sym1 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Mycompare_0123456789Sym1KindInference GHC.Tuple.()) + data Mycompare_0123456789Sym1 (l :: Foo) (l :: TyFun Foo Ordering) + = forall arg. KindOf (Apply (Mycompare_0123456789Sym1 l) arg) ~ KindOf (Mycompare_0123456789Sym2 l arg) => + Mycompare_0123456789Sym1KindInference + type instance Apply (Mycompare_0123456789Sym1 l) l = Mycompare_0123456789Sym2 l l + instance SuppressUnusedWarnings Mycompare_0123456789Sym0 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Mycompare_0123456789Sym0KindInference GHC.Tuple.()) + data Mycompare_0123456789Sym0 (l :: TyFun Foo (TyFun Foo Ordering + -> GHC.Types.Type)) + = forall arg. KindOf (Apply Mycompare_0123456789Sym0 arg) ~ KindOf (Mycompare_0123456789Sym1 arg) => + Mycompare_0123456789Sym0KindInference + type instance Apply Mycompare_0123456789Sym0 l = Mycompare_0123456789Sym1 l + instance PMyOrd (KProxy :: KProxy Foo) where + type Mycompare (a :: Foo) (a :: Foo) = Apply (Apply Mycompare_0123456789Sym0 a) a + type family TFHelper_0123456789 (a :: Foo2) + (a :: Foo2) :: Bool where + TFHelper_0123456789 F F = TrueSym0 + TFHelper_0123456789 G G = TrueSym0 + TFHelper_0123456789 F G = FalseSym0 + TFHelper_0123456789 G F = FalseSym0 + type TFHelper_0123456789Sym2 (t :: Foo2) (t :: Foo2) = + TFHelper_0123456789 t t + instance SuppressUnusedWarnings TFHelper_0123456789Sym1 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) TFHelper_0123456789Sym1KindInference GHC.Tuple.()) + data TFHelper_0123456789Sym1 (l :: Foo2) (l :: TyFun Foo2 Bool) + = forall arg. KindOf (Apply (TFHelper_0123456789Sym1 l) arg) ~ KindOf (TFHelper_0123456789Sym2 l arg) => + TFHelper_0123456789Sym1KindInference + type instance Apply (TFHelper_0123456789Sym1 l) l = TFHelper_0123456789Sym2 l l + instance SuppressUnusedWarnings TFHelper_0123456789Sym0 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) TFHelper_0123456789Sym0KindInference GHC.Tuple.()) + data TFHelper_0123456789Sym0 (l :: TyFun Foo2 (TyFun Foo2 Bool + -> GHC.Types.Type)) + = forall arg. KindOf (Apply TFHelper_0123456789Sym0 arg) ~ KindOf (TFHelper_0123456789Sym1 arg) => + TFHelper_0123456789Sym0KindInference + type instance Apply TFHelper_0123456789Sym0 l = TFHelper_0123456789Sym1 l + instance PEq (KProxy :: KProxy Foo2) where + type (:==) (a :: Foo2) (a :: Foo2) = Apply (Apply TFHelper_0123456789Sym0 a) a + infix 4 %:<=> + sFooCompare :: + forall (t :: Foo) (t :: Foo). + Sing t + -> Sing t -> Sing (Apply (Apply FooCompareSym0 t) t :: Ordering) + sConst :: + forall (t :: a) (t :: b). + Sing t -> Sing t -> Sing (Apply (Apply ConstSym0 t) t :: a) + sFooCompare SA SA + = let + lambda :: + (t ~ ASym0, t ~ ASym0) => + Sing (Apply (Apply FooCompareSym0 t) t :: Ordering) + lambda = SEQ + in lambda + sFooCompare SA SB + = let + lambda :: + (t ~ ASym0, t ~ BSym0) => + Sing (Apply (Apply FooCompareSym0 t) t :: Ordering) + lambda = SLT + in lambda + sFooCompare SB SB + = let + lambda :: + (t ~ BSym0, t ~ BSym0) => + Sing (Apply (Apply FooCompareSym0 t) t :: Ordering) + lambda = SGT + in lambda + sFooCompare SB SA + = let + lambda :: + (t ~ BSym0, t ~ ASym0) => + Sing (Apply (Apply FooCompareSym0 t) t :: Ordering) + lambda = SEQ + in lambda + sConst sX _s_z_0123456789 + = let + lambda :: + forall x _z_0123456789. + (t ~ x, t ~ _z_0123456789) => + Sing x + -> Sing _z_0123456789 -> Sing (Apply (Apply ConstSym0 t) t :: a) + lambda x _z_0123456789 = x + in lambda sX _s_z_0123456789 + data instance Sing (z :: Foo) = z ~ A => SA | z ~ B => SB + type SFoo = (Sing :: Foo -> GHC.Types.Type) + instance SingKind (KProxy :: KProxy Foo) where + type DemoteRep (KProxy :: KProxy Foo) = Foo + fromSing SA = A + fromSing SB = B + toSing A = SomeSing SA + toSing B = SomeSing SB + data instance Sing (z :: Foo2) = z ~ F => SF | z ~ G => SG + type SFoo2 = (Sing :: Foo2 -> GHC.Types.Type) + instance SingKind (KProxy :: KProxy Foo2) where + type DemoteRep (KProxy :: KProxy Foo2) = Foo2 + fromSing SF = F + fromSing SG = G + toSing F = SomeSing SF + toSing G = SomeSing SG + class kproxy ~ KProxy => SMyOrd (kproxy :: KProxy a) where + sMycompare :: + forall (t :: a) (t :: a). + Sing t + -> Sing t -> Sing (Apply (Apply MycompareSym0 t) t :: Ordering) + (%:<=>) :: + forall (t :: a) (t :: a). + Sing t -> Sing t -> Sing (Apply (Apply (:<=>$) t) t :: Ordering) + default (%:<=>) :: + forall (t :: a) (t :: a). + Apply (Apply (:<=>$) t) t ~ Apply (Apply TFHelper_0123456789Sym0 t) t => + Sing t -> Sing t -> Sing (Apply (Apply (:<=>$) t) t :: Ordering) + (%:<=>) sA_0123456789 sA_0123456789 + = let + lambda :: + forall a_0123456789 a_0123456789. + (t ~ a_0123456789, t ~ a_0123456789) => + Sing a_0123456789 + -> Sing a_0123456789 + -> Sing (Apply (Apply (:<=>$) t) t :: Ordering) + lambda a_0123456789 a_0123456789 + = applySing + (applySing + (singFun2 (Proxy :: Proxy MycompareSym0) sMycompare) a_0123456789) + a_0123456789 + in lambda sA_0123456789 sA_0123456789 + instance SMyOrd (KProxy :: KProxy Nat) where + sMycompare :: + forall (t :: Nat) (t :: Nat). + Sing t + -> Sing t -> Sing (Apply (Apply MycompareSym0 t) t :: Ordering) + sMycompare SZero SZero + = let + lambda :: + (t ~ ZeroSym0, t ~ ZeroSym0) => + Sing (Apply (Apply MycompareSym0 t) t :: Ordering) + lambda = SEQ + in lambda + sMycompare SZero (SSucc _s_z_0123456789) + = let + lambda :: + forall _z_0123456789. + (t ~ ZeroSym0, t ~ Apply SuccSym0 _z_0123456789) => + Sing _z_0123456789 + -> Sing (Apply (Apply MycompareSym0 t) t :: Ordering) + lambda _z_0123456789 = SLT + in lambda _s_z_0123456789 + sMycompare (SSucc _s_z_0123456789) SZero + = let + lambda :: + forall _z_0123456789. + (t ~ Apply SuccSym0 _z_0123456789, t ~ ZeroSym0) => + Sing _z_0123456789 + -> Sing (Apply (Apply MycompareSym0 t) t :: Ordering) + lambda _z_0123456789 = SGT + in lambda _s_z_0123456789 + sMycompare (SSucc sN) (SSucc sM) + = let + lambda :: + forall n m. + (t ~ Apply SuccSym0 n, t ~ Apply SuccSym0 m) => + Sing n + -> Sing m -> Sing (Apply (Apply MycompareSym0 t) t :: Ordering) + lambda n m + = applySing + (applySing (singFun2 (Proxy :: Proxy MycompareSym0) sMycompare) m) + n + in lambda sN sM + instance SMyOrd (KProxy :: KProxy ()) where + sMycompare :: + forall (t :: ()) (t :: ()). + Sing t + -> Sing t -> Sing (Apply (Apply MycompareSym0 t) t :: Ordering) + sMycompare _s_z_0123456789 sA_0123456789 + = let + lambda :: + forall _z_0123456789 a_0123456789. + (t ~ _z_0123456789, t ~ a_0123456789) => + Sing _z_0123456789 + -> Sing a_0123456789 + -> Sing (Apply (Apply MycompareSym0 t) t :: Ordering) + lambda _z_0123456789 a_0123456789 + = applySing + (applySing (singFun2 (Proxy :: Proxy ConstSym0) sConst) SEQ) + a_0123456789 + in lambda _s_z_0123456789 sA_0123456789 + instance SMyOrd (KProxy :: KProxy Foo) where + sMycompare :: + forall (t :: Foo) (t :: Foo). + Sing t + -> Sing t -> Sing (Apply (Apply MycompareSym0 t) t :: Ordering) + sMycompare sA_0123456789 sA_0123456789 + = let + lambda :: + forall a_0123456789 a_0123456789. + (t ~ a_0123456789, t ~ a_0123456789) => + Sing a_0123456789 + -> Sing a_0123456789 + -> Sing (Apply (Apply MycompareSym0 t) t :: Ordering) + lambda a_0123456789 a_0123456789 + = applySing + (applySing + (singFun2 (Proxy :: Proxy FooCompareSym0) sFooCompare) + a_0123456789) + a_0123456789 + in lambda sA_0123456789 sA_0123456789 + instance SEq (KProxy :: KProxy Foo2) where + (%:==) :: + forall (a :: Foo2) (b :: Foo2). + Sing a -> Sing b -> Sing ((:==) a b) + (%:==) SF SF + = let + lambda :: (a ~ FSym0, b ~ FSym0) => Sing (Apply (Apply (:==$) a) b) + lambda = STrue + in lambda + (%:==) SG SG + = let + lambda :: (a ~ GSym0, b ~ GSym0) => Sing (Apply (Apply (:==$) a) b) + lambda = STrue + in lambda + (%:==) SF SG + = let + lambda :: (a ~ FSym0, b ~ GSym0) => Sing (Apply (Apply (:==$) a) b) + lambda = SFalse + in lambda + (%:==) SG SF + = let + lambda :: (a ~ GSym0, b ~ FSym0) => Sing (Apply (Apply (:==$) a) b) + lambda = SFalse + in lambda + instance SingI A where + sing = SA + instance SingI B where + sing = SB + instance SingI F where + sing = SF + instance SingI G where + sing = SG +Singletons/Classes.hs:(0,0)-(0,0): Splicing declarations + promote + [d| instance Ord Foo2 where + F `compare` F = EQ + F `compare` _ = LT + _ `compare` _ = GT + instance MyOrd Foo2 where + F `mycompare` F = EQ + F `mycompare` _ = LT + _ `mycompare` _ = GT |] + ======> + instance MyOrd Foo2 where + mycompare F F = EQ + mycompare F _ = LT + mycompare _ _ = GT + instance Ord Foo2 where + compare F F = EQ + compare F _ = LT + compare _ _ = GT + type family Mycompare_0123456789 (a :: Foo2) + (a :: Foo2) :: Ordering where + Mycompare_0123456789 F F = EQSym0 + Mycompare_0123456789 F _z_0123456789 = LTSym0 + Mycompare_0123456789 _z_0123456789 _z_0123456789 = GTSym0 + type Mycompare_0123456789Sym2 (t :: Foo2) (t :: Foo2) = + Mycompare_0123456789 t t + instance SuppressUnusedWarnings Mycompare_0123456789Sym1 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Mycompare_0123456789Sym1KindInference GHC.Tuple.()) + data Mycompare_0123456789Sym1 (l :: Foo2) + (l :: TyFun Foo2 Ordering) + = forall arg. KindOf (Apply (Mycompare_0123456789Sym1 l) arg) ~ KindOf (Mycompare_0123456789Sym2 l arg) => + Mycompare_0123456789Sym1KindInference + type instance Apply (Mycompare_0123456789Sym1 l) l = Mycompare_0123456789Sym2 l l + instance SuppressUnusedWarnings Mycompare_0123456789Sym0 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Mycompare_0123456789Sym0KindInference GHC.Tuple.()) + data Mycompare_0123456789Sym0 (l :: TyFun Foo2 (TyFun Foo2 Ordering + -> GHC.Types.Type)) + = forall arg. KindOf (Apply Mycompare_0123456789Sym0 arg) ~ KindOf (Mycompare_0123456789Sym1 arg) => + Mycompare_0123456789Sym0KindInference + type instance Apply Mycompare_0123456789Sym0 l = Mycompare_0123456789Sym1 l + instance PMyOrd (KProxy :: KProxy Foo2) where + type Mycompare (a :: Foo2) (a :: Foo2) = Apply (Apply Mycompare_0123456789Sym0 a) a + type family Compare_0123456789 (a :: Foo2) + (a :: Foo2) :: Ordering where + Compare_0123456789 F F = EQSym0 + Compare_0123456789 F _z_0123456789 = LTSym0 + Compare_0123456789 _z_0123456789 _z_0123456789 = GTSym0 + type Compare_0123456789Sym2 (t :: Foo2) (t :: Foo2) = + Compare_0123456789 t t + instance SuppressUnusedWarnings Compare_0123456789Sym1 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Compare_0123456789Sym1KindInference GHC.Tuple.()) + data Compare_0123456789Sym1 (l :: Foo2) (l :: TyFun Foo2 Ordering) + = forall arg. KindOf (Apply (Compare_0123456789Sym1 l) arg) ~ KindOf (Compare_0123456789Sym2 l arg) => + Compare_0123456789Sym1KindInference + type instance Apply (Compare_0123456789Sym1 l) l = Compare_0123456789Sym2 l l + instance SuppressUnusedWarnings Compare_0123456789Sym0 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Compare_0123456789Sym0KindInference GHC.Tuple.()) + data Compare_0123456789Sym0 (l :: TyFun Foo2 (TyFun Foo2 Ordering + -> GHC.Types.Type)) + = forall arg. KindOf (Apply Compare_0123456789Sym0 arg) ~ KindOf (Compare_0123456789Sym1 arg) => + Compare_0123456789Sym0KindInference + type instance Apply Compare_0123456789Sym0 l = Compare_0123456789Sym1 l + instance POrd (KProxy :: KProxy Foo2) where + type Compare (a :: Foo2) (a :: Foo2) = Apply (Apply Compare_0123456789Sym0 a) a +Singletons/Classes.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| data Nat' = Zero' | Succ' Nat' + + instance MyOrd Nat' where + Zero' `mycompare` Zero' = EQ + Zero' `mycompare` (Succ' _) = LT + (Succ' _) `mycompare` Zero' = GT + (Succ' n) `mycompare` (Succ' m) = m `mycompare` n |] + ======> + data Nat' = Zero' | Succ' Nat' + instance MyOrd Nat' where + mycompare Zero' Zero' = EQ + mycompare Zero' (Succ' _) = LT + mycompare (Succ' _) Zero' = GT + mycompare (Succ' n) (Succ' m) = (m `mycompare` n) + type Zero'Sym0 = Zero' + type Succ'Sym1 (t :: Nat') = Succ' t + instance SuppressUnusedWarnings Succ'Sym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Succ'Sym0KindInference GHC.Tuple.()) + data Succ'Sym0 (l :: TyFun Nat' Nat') + = forall arg. KindOf (Apply Succ'Sym0 arg) ~ KindOf (Succ'Sym1 arg) => + Succ'Sym0KindInference + type instance Apply Succ'Sym0 l = Succ'Sym1 l + type family Mycompare_0123456789 (a :: Nat') + (a :: Nat') :: Ordering where + Mycompare_0123456789 Zero' Zero' = EQSym0 + Mycompare_0123456789 Zero' (Succ' _z_0123456789) = LTSym0 + Mycompare_0123456789 (Succ' _z_0123456789) Zero' = GTSym0 + Mycompare_0123456789 (Succ' n) (Succ' m) = Apply (Apply MycompareSym0 m) n + type Mycompare_0123456789Sym2 (t :: Nat') (t :: Nat') = + Mycompare_0123456789 t t + instance SuppressUnusedWarnings Mycompare_0123456789Sym1 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Mycompare_0123456789Sym1KindInference GHC.Tuple.()) + data Mycompare_0123456789Sym1 (l :: Nat') + (l :: TyFun Nat' Ordering) + = forall arg. KindOf (Apply (Mycompare_0123456789Sym1 l) arg) ~ KindOf (Mycompare_0123456789Sym2 l arg) => + Mycompare_0123456789Sym1KindInference + type instance Apply (Mycompare_0123456789Sym1 l) l = Mycompare_0123456789Sym2 l l + instance SuppressUnusedWarnings Mycompare_0123456789Sym0 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Mycompare_0123456789Sym0KindInference GHC.Tuple.()) + data Mycompare_0123456789Sym0 (l :: TyFun Nat' (TyFun Nat' Ordering + -> GHC.Types.Type)) + = forall arg. KindOf (Apply Mycompare_0123456789Sym0 arg) ~ KindOf (Mycompare_0123456789Sym1 arg) => + Mycompare_0123456789Sym0KindInference + type instance Apply Mycompare_0123456789Sym0 l = Mycompare_0123456789Sym1 l + instance PMyOrd (KProxy :: KProxy Nat') where + type Mycompare (a :: Nat') (a :: Nat') = Apply (Apply Mycompare_0123456789Sym0 a) a + data instance Sing (z :: Nat') + = z ~ Zero' => SZero' | + forall (n :: Nat'). z ~ Succ' n => SSucc' (Sing (n :: Nat')) + type SNat' = (Sing :: Nat' -> GHC.Types.Type) + instance SingKind (KProxy :: KProxy Nat') where + type DemoteRep (KProxy :: KProxy Nat') = Nat' + fromSing SZero' = Zero' + fromSing (SSucc' b) = Succ' (fromSing b) + toSing Zero' = SomeSing SZero' + toSing (Succ' b) + = case toSing b :: SomeSing (KProxy :: KProxy Nat') of { + SomeSing c -> SomeSing (SSucc' c) } + instance SMyOrd (KProxy :: KProxy Nat') where + sMycompare :: + forall (t :: Nat') (t :: Nat'). + Sing t + -> Sing t + -> Sing (Apply (Apply (MycompareSym0 :: TyFun Nat' (TyFun Nat' Ordering + -> GHC.Types.Type) + -> GHC.Types.Type) t :: TyFun Nat' Ordering + -> GHC.Types.Type) t :: Ordering) + sMycompare SZero' SZero' + = let + lambda :: + (t ~ Zero'Sym0, t ~ Zero'Sym0) => + Sing (Apply (Apply MycompareSym0 t) t :: Ordering) + lambda = SEQ + in lambda + sMycompare SZero' (SSucc' _s_z_0123456789) + = let + lambda :: + forall _z_0123456789. + (t ~ Zero'Sym0, t ~ Apply Succ'Sym0 _z_0123456789) => + Sing _z_0123456789 + -> Sing (Apply (Apply MycompareSym0 t) t :: Ordering) + lambda _z_0123456789 = SLT + in lambda _s_z_0123456789 + sMycompare (SSucc' _s_z_0123456789) SZero' + = let + lambda :: + forall _z_0123456789. + (t ~ Apply Succ'Sym0 _z_0123456789, t ~ Zero'Sym0) => + Sing _z_0123456789 + -> Sing (Apply (Apply MycompareSym0 t) t :: Ordering) + lambda _z_0123456789 = SGT + in lambda _s_z_0123456789 + sMycompare (SSucc' sN) (SSucc' sM) + = let + lambda :: + forall n m. + (t ~ Apply Succ'Sym0 n, t ~ Apply Succ'Sym0 m) => + Sing n + -> Sing m -> Sing (Apply (Apply MycompareSym0 t) t :: Ordering) + lambda n m + = applySing + (applySing (singFun2 (Proxy :: Proxy MycompareSym0) sMycompare) m) + n + in lambda sN sM + instance SingI Zero' where + sing = SZero' + instance SingI n => SingI (Succ' (n :: Nat')) where + sing = SSucc' sing diff --git a/tests/compile-and-dump/Singletons/Classes2.ghc710.template b/tests/compile-and-dump/Singletons/Classes2.ghc710.template --- a/tests/compile-and-dump/Singletons/Classes2.ghc710.template +++ b/tests/compile-and-dump/Singletons/Classes2.ghc710.template @@ -77,7 +77,7 @@ = let lambda :: (t0 ~ ZeroFooSym0, t1 ~ ZeroFooSym0) => - Sing (Apply (Apply MycompareSym0 ZeroFooSym0) ZeroFooSym0 :: Ordering) + Sing (Apply (Apply MycompareSym0 t0) t1 :: Ordering) lambda = SEQ in lambda sMycompare SZeroFoo (SSuccFoo _s_z_0123456789) @@ -86,7 +86,7 @@ forall _z_0123456789. (t0 ~ ZeroFooSym0, t1 ~ Apply SuccFooSym0 _z_0123456789) => Sing _z_0123456789 - -> Sing (Apply (Apply MycompareSym0 ZeroFooSym0) (Apply SuccFooSym0 _z_0123456789) :: Ordering) + -> Sing (Apply (Apply MycompareSym0 t0) t1 :: Ordering) lambda _z_0123456789 = SLT in lambda _s_z_0123456789 sMycompare (SSuccFoo _s_z_0123456789) SZeroFoo @@ -95,7 +95,7 @@ forall _z_0123456789. (t0 ~ Apply SuccFooSym0 _z_0123456789, t1 ~ ZeroFooSym0) => Sing _z_0123456789 - -> Sing (Apply (Apply MycompareSym0 (Apply SuccFooSym0 _z_0123456789)) ZeroFooSym0 :: Ordering) + -> Sing (Apply (Apply MycompareSym0 t0) t1 :: Ordering) lambda _z_0123456789 = SGT in lambda _s_z_0123456789 sMycompare (SSuccFoo sN) (SSuccFoo sM) @@ -103,8 +103,7 @@ lambda :: forall n m. (t0 ~ Apply SuccFooSym0 n, t1 ~ Apply SuccFooSym0 m) => Sing n - -> Sing m - -> Sing (Apply (Apply MycompareSym0 (Apply SuccFooSym0 n)) (Apply SuccFooSym0 m) :: Ordering) + -> Sing m -> Sing (Apply (Apply MycompareSym0 t0) t1 :: Ordering) lambda n m = applySing (applySing (singFun2 (Proxy :: Proxy MycompareSym0) sMycompare) m) diff --git a/tests/compile-and-dump/Singletons/Classes2.ghc80.template b/tests/compile-and-dump/Singletons/Classes2.ghc80.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/Classes2.ghc80.template @@ -0,0 +1,116 @@ +Singletons/Classes2.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| data NatFoo = ZeroFoo | SuccFoo NatFoo + + instance MyOrd NatFoo where + ZeroFoo `mycompare` ZeroFoo = EQ + ZeroFoo `mycompare` (SuccFoo _) = LT + (SuccFoo _) `mycompare` ZeroFoo = GT + (SuccFoo n) `mycompare` (SuccFoo m) = m `mycompare` n |] + ======> + data NatFoo = ZeroFoo | SuccFoo NatFoo + instance MyOrd NatFoo where + mycompare ZeroFoo ZeroFoo = EQ + mycompare ZeroFoo (SuccFoo _) = LT + mycompare (SuccFoo _) ZeroFoo = GT + mycompare (SuccFoo n) (SuccFoo m) = (m `mycompare` n) + type ZeroFooSym0 = ZeroFoo + type SuccFooSym1 (t :: NatFoo) = SuccFoo t + instance SuppressUnusedWarnings SuccFooSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) SuccFooSym0KindInference GHC.Tuple.()) + data SuccFooSym0 (l :: TyFun NatFoo NatFoo) + = forall arg. KindOf (Apply SuccFooSym0 arg) ~ KindOf (SuccFooSym1 arg) => + SuccFooSym0KindInference + type instance Apply SuccFooSym0 l = SuccFooSym1 l + type family Mycompare_0123456789 (a :: NatFoo) + (a :: NatFoo) :: Ordering where + Mycompare_0123456789 ZeroFoo ZeroFoo = EQSym0 + Mycompare_0123456789 ZeroFoo (SuccFoo _z_0123456789) = LTSym0 + Mycompare_0123456789 (SuccFoo _z_0123456789) ZeroFoo = GTSym0 + Mycompare_0123456789 (SuccFoo n) (SuccFoo m) = Apply (Apply MycompareSym0 m) n + type Mycompare_0123456789Sym2 (t :: NatFoo) (t :: NatFoo) = + Mycompare_0123456789 t t + instance SuppressUnusedWarnings Mycompare_0123456789Sym1 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Mycompare_0123456789Sym1KindInference GHC.Tuple.()) + data Mycompare_0123456789Sym1 (l :: NatFoo) + (l :: TyFun NatFoo Ordering) + = forall arg. KindOf (Apply (Mycompare_0123456789Sym1 l) arg) ~ KindOf (Mycompare_0123456789Sym2 l arg) => + Mycompare_0123456789Sym1KindInference + type instance Apply (Mycompare_0123456789Sym1 l) l = Mycompare_0123456789Sym2 l l + instance SuppressUnusedWarnings Mycompare_0123456789Sym0 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Mycompare_0123456789Sym0KindInference GHC.Tuple.()) + data Mycompare_0123456789Sym0 (l :: TyFun NatFoo (TyFun NatFoo Ordering + -> GHC.Types.Type)) + = forall arg. KindOf (Apply Mycompare_0123456789Sym0 arg) ~ KindOf (Mycompare_0123456789Sym1 arg) => + Mycompare_0123456789Sym0KindInference + type instance Apply Mycompare_0123456789Sym0 l = Mycompare_0123456789Sym1 l + instance PMyOrd (KProxy :: KProxy NatFoo) where + type Mycompare (a :: NatFoo) (a :: NatFoo) = Apply (Apply Mycompare_0123456789Sym0 a) a + data instance Sing (z :: NatFoo) + = z ~ ZeroFoo => SZeroFoo | + forall (n :: NatFoo). z ~ SuccFoo n => + SSuccFoo (Sing (n :: NatFoo)) + type SNatFoo = (Sing :: NatFoo -> GHC.Types.Type) + instance SingKind (KProxy :: KProxy NatFoo) where + type DemoteRep (KProxy :: KProxy NatFoo) = NatFoo + fromSing SZeroFoo = ZeroFoo + fromSing (SSuccFoo b) = SuccFoo (fromSing b) + toSing ZeroFoo = SomeSing SZeroFoo + toSing (SuccFoo b) + = case toSing b :: SomeSing (KProxy :: KProxy NatFoo) of { + SomeSing c -> SomeSing (SSuccFoo c) } + instance SMyOrd (KProxy :: KProxy NatFoo) where + sMycompare :: + forall (t0 :: NatFoo) (t1 :: NatFoo). + Sing t0 + -> Sing t1 + -> Sing (Apply (Apply (MycompareSym0 :: TyFun NatFoo (TyFun NatFoo Ordering + -> GHC.Types.Type) + -> GHC.Types.Type) t0 :: TyFun NatFoo Ordering + -> GHC.Types.Type) t1 :: Ordering) + sMycompare SZeroFoo SZeroFoo + = let + lambda :: + (t0 ~ ZeroFooSym0, t1 ~ ZeroFooSym0) => + Sing (Apply (Apply MycompareSym0 t0) t1 :: Ordering) + lambda = SEQ + in lambda + sMycompare SZeroFoo (SSuccFoo _s_z_0123456789) + = let + lambda :: + forall _z_0123456789. + (t0 ~ ZeroFooSym0, t1 ~ Apply SuccFooSym0 _z_0123456789) => + Sing _z_0123456789 + -> Sing (Apply (Apply MycompareSym0 t0) t1 :: Ordering) + lambda _z_0123456789 = SLT + in lambda _s_z_0123456789 + sMycompare (SSuccFoo _s_z_0123456789) SZeroFoo + = let + lambda :: + forall _z_0123456789. + (t0 ~ Apply SuccFooSym0 _z_0123456789, t1 ~ ZeroFooSym0) => + Sing _z_0123456789 + -> Sing (Apply (Apply MycompareSym0 t0) t1 :: Ordering) + lambda _z_0123456789 = SGT + in lambda _s_z_0123456789 + sMycompare (SSuccFoo sN) (SSuccFoo sM) + = let + lambda :: + forall n m. + (t0 ~ Apply SuccFooSym0 n, t1 ~ Apply SuccFooSym0 m) => + Sing n + -> Sing m -> Sing (Apply (Apply MycompareSym0 t0) t1 :: Ordering) + lambda n m + = applySing + (applySing (singFun2 (Proxy :: Proxy MycompareSym0) sMycompare) m) + n + in lambda sN sM + instance SingI ZeroFoo where + sing = SZeroFoo + instance SingI n => SingI (SuccFoo (n :: NatFoo)) where + sing = SSuccFoo sing diff --git a/tests/compile-and-dump/Singletons/Contains.ghc710.template b/tests/compile-and-dump/Singletons/Contains.ghc710.template --- a/tests/compile-and-dump/Singletons/Contains.ghc710.template +++ b/tests/compile-and-dump/Singletons/Contains.ghc710.template @@ -7,18 +7,21 @@ contains :: forall a. Eq a => a -> [a] -> Bool contains _ GHC.Types.[] = False contains elt (h GHC.Types.: t) = ((elt == h) || (contains elt t)) - type ContainsSym2 (t :: a) (t :: [a]) = Contains t t + type ContainsSym2 (t :: a0123456789) (t :: [a0123456789]) = + Contains t t instance SuppressUnusedWarnings ContainsSym1 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) ContainsSym1KindInference GHC.Tuple.()) - data ContainsSym1 (l :: a) (l :: TyFun [a] Bool) + data ContainsSym1 (l :: a0123456789) + (l :: TyFun [a0123456789] Bool) = forall arg. KindOf (Apply (ContainsSym1 l) arg) ~ KindOf (ContainsSym2 l arg) => ContainsSym1KindInference type instance Apply (ContainsSym1 l) l = ContainsSym2 l l instance SuppressUnusedWarnings ContainsSym0 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) ContainsSym0KindInference GHC.Tuple.()) - data ContainsSym0 (l :: TyFun a (TyFun [a] Bool -> *)) + data ContainsSym0 (l :: TyFun a0123456789 (TyFun [a0123456789] Bool + -> *)) = forall arg. KindOf (Apply ContainsSym0 arg) ~ KindOf (ContainsSym1 arg) => ContainsSym0KindInference type instance Apply ContainsSym0 l = ContainsSym1 l @@ -32,8 +35,7 @@ = let lambda :: forall _z_0123456789. (t ~ _z_0123456789, t ~ '[]) => - Sing _z_0123456789 - -> Sing (Apply (Apply ContainsSym0 _z_0123456789) '[] :: Bool) + Sing _z_0123456789 -> Sing (Apply (Apply ContainsSym0 t) t :: Bool) lambda _z_0123456789 = SFalse in lambda _s_z_0123456789 sContains sElt (SCons sH sT) @@ -42,8 +44,7 @@ forall elt h t. (t ~ elt, t ~ Apply (Apply (:$) h) t) => Sing elt -> Sing h - -> Sing t - -> Sing (Apply (Apply ContainsSym0 elt) (Apply (Apply (:$) h) t) :: Bool) + -> Sing t -> Sing (Apply (Apply ContainsSym0 t) t :: Bool) lambda elt h t = applySing (applySing diff --git a/tests/compile-and-dump/Singletons/Contains.ghc80.template b/tests/compile-and-dump/Singletons/Contains.ghc80.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/Contains.ghc80.template @@ -0,0 +1,60 @@ +Singletons/Contains.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| contains :: Eq a => a -> [a] -> Bool + contains _ [] = False + contains elt (h : t) = (elt == h) || (contains elt t) |] + ======> + contains :: forall a. Eq a => a -> [a] -> Bool + contains _ GHC.Types.[] = False + contains elt (h GHC.Types.: t) = ((elt == h) || (contains elt t)) + type ContainsSym2 (t :: a0123456789) (t :: [a0123456789]) = + Contains t t + instance SuppressUnusedWarnings ContainsSym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) ContainsSym1KindInference GHC.Tuple.()) + data ContainsSym1 (l :: a0123456789) + (l :: TyFun [a0123456789] Bool) + = forall arg. KindOf (Apply (ContainsSym1 l) arg) ~ KindOf (ContainsSym2 l arg) => + ContainsSym1KindInference + type instance Apply (ContainsSym1 l) l = ContainsSym2 l l + instance SuppressUnusedWarnings ContainsSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) ContainsSym0KindInference GHC.Tuple.()) + data ContainsSym0 (l :: TyFun a0123456789 (TyFun [a0123456789] Bool + -> GHC.Types.Type)) + = forall arg. KindOf (Apply ContainsSym0 arg) ~ KindOf (ContainsSym1 arg) => + ContainsSym0KindInference + type instance Apply ContainsSym0 l = ContainsSym1 l + type family Contains (a :: a) (a :: [a]) :: Bool where + Contains _z_0123456789 '[] = FalseSym0 + Contains elt ((:) h t) = Apply (Apply (:||$) (Apply (Apply (:==$) elt) h)) (Apply (Apply ContainsSym0 elt) t) + sContains :: + forall (t :: a) (t :: [a]). + SEq (KProxy :: KProxy a) => + Sing t -> Sing t -> Sing (Apply (Apply ContainsSym0 t) t :: Bool) + sContains _s_z_0123456789 SNil + = let + lambda :: + forall _z_0123456789. + (t ~ _z_0123456789, t ~ '[]) => + Sing _z_0123456789 -> Sing (Apply (Apply ContainsSym0 t) t :: Bool) + lambda _z_0123456789 = SFalse + in lambda _s_z_0123456789 + sContains sElt (SCons sH sT) + = let + lambda :: + forall elt h t. + (t ~ elt, t ~ Apply (Apply (:$) h) t) => + Sing elt + -> Sing h + -> Sing t -> Sing (Apply (Apply ContainsSym0 t) t :: Bool) + lambda elt h t + = applySing + (applySing + (singFun2 (Proxy :: Proxy (:||$)) (%:||)) + (applySing + (applySing (singFun2 (Proxy :: Proxy (:==$)) (%:==)) elt) h)) + (applySing + (applySing (singFun2 (Proxy :: Proxy ContainsSym0) sContains) elt) + t) + in lambda sElt sH sT diff --git a/tests/compile-and-dump/Singletons/DataValues.ghc710.template b/tests/compile-and-dump/Singletons/DataValues.ghc710.template --- a/tests/compile-and-dump/Singletons/DataValues.ghc710.template +++ b/tests/compile-and-dump/Singletons/DataValues.ghc710.template @@ -16,18 +16,20 @@ complex = Pair (Pair (Just Zero) Zero) False tuple = (False, Just Zero, True) aList = [Zero, Succ Zero, Succ (Succ Zero)] - type PairSym2 (t :: a) (t :: b) = Pair t t + type PairSym2 (t :: a0123456789) (t :: b0123456789) = Pair t t instance SuppressUnusedWarnings PairSym1 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) PairSym1KindInference GHC.Tuple.()) - data PairSym1 (l :: a) (l :: TyFun b (Pair a b)) + data PairSym1 (l :: a0123456789) + (l :: TyFun b0123456789 (Pair a0123456789 b0123456789)) = forall arg. KindOf (Apply (PairSym1 l) arg) ~ KindOf (PairSym2 l arg) => PairSym1KindInference type instance Apply (PairSym1 l) l = PairSym2 l l instance SuppressUnusedWarnings PairSym0 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) PairSym0KindInference GHC.Tuple.()) - data PairSym0 (l :: TyFun a (TyFun b (Pair a b) -> *)) + data PairSym0 (l :: TyFun a0123456789 (TyFun b0123456789 (Pair a0123456789 b0123456789) + -> *)) = forall arg. KindOf (Apply PairSym0 arg) ~ KindOf (PairSym1 arg) => PairSym0KindInference type instance Apply PairSym0 l = PairSym1 l diff --git a/tests/compile-and-dump/Singletons/DataValues.ghc80.template b/tests/compile-and-dump/Singletons/DataValues.ghc80.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/DataValues.ghc80.template @@ -0,0 +1,106 @@ +Singletons/DataValues.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| pr = Pair (Succ Zero) ([Zero]) + complex = Pair (Pair (Just Zero) Zero) False + tuple = (False, Just Zero, True) + aList = [Zero, Succ Zero, Succ (Succ Zero)] + + data Pair a b + = Pair a b + deriving (Show) |] + ======> + data Pair a b + = Pair a b + deriving (Show) + pr = Pair (Succ Zero) [Zero] + complex = Pair (Pair (Just Zero) Zero) False + tuple = (False, Just Zero, True) + aList = [Zero, Succ Zero, Succ (Succ Zero)] + type PairSym2 (t :: a0123456789) (t :: b0123456789) = Pair t t + instance SuppressUnusedWarnings PairSym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) PairSym1KindInference GHC.Tuple.()) + data PairSym1 (l :: a0123456789) + (l :: TyFun b0123456789 (Pair a0123456789 b0123456789)) + = forall arg. KindOf (Apply (PairSym1 l) arg) ~ KindOf (PairSym2 l arg) => + PairSym1KindInference + type instance Apply (PairSym1 l) l = PairSym2 l l + instance SuppressUnusedWarnings PairSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) PairSym0KindInference GHC.Tuple.()) + data PairSym0 (l :: TyFun a0123456789 (TyFun b0123456789 (Pair a0123456789 b0123456789) + -> GHC.Types.Type)) + = forall arg. KindOf (Apply PairSym0 arg) ~ KindOf (PairSym1 arg) => + PairSym0KindInference + type instance Apply PairSym0 l = PairSym1 l + type AListSym0 = AList + type TupleSym0 = Tuple + type ComplexSym0 = Complex + type PrSym0 = Pr + type family AList where + AList = Apply (Apply (:$) ZeroSym0) (Apply (Apply (:$) (Apply SuccSym0 ZeroSym0)) (Apply (Apply (:$) (Apply SuccSym0 (Apply SuccSym0 ZeroSym0))) '[])) + type family Tuple where + Tuple = Apply (Apply (Apply Tuple3Sym0 FalseSym0) (Apply JustSym0 ZeroSym0)) TrueSym0 + type family Complex where + Complex = Apply (Apply PairSym0 (Apply (Apply PairSym0 (Apply JustSym0 ZeroSym0)) ZeroSym0)) FalseSym0 + type family Pr where + Pr = Apply (Apply PairSym0 (Apply SuccSym0 ZeroSym0)) (Apply (Apply (:$) ZeroSym0) '[]) + sAList :: Sing AListSym0 + sTuple :: Sing TupleSym0 + sComplex :: Sing ComplexSym0 + sPr :: Sing PrSym0 + sAList + = applySing + (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SZero) + (applySing + (applySing + (singFun2 (Proxy :: Proxy (:$)) SCons) + (applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) SZero)) + (applySing + (applySing + (singFun2 (Proxy :: Proxy (:$)) SCons) + (applySing + (singFun1 (Proxy :: Proxy SuccSym0) SSucc) + (applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) SZero))) + SNil)) + sTuple + = applySing + (applySing + (applySing (singFun3 (Proxy :: Proxy Tuple3Sym0) STuple3) SFalse) + (applySing (singFun1 (Proxy :: Proxy JustSym0) SJust) SZero)) + STrue + sComplex + = applySing + (applySing + (singFun2 (Proxy :: Proxy PairSym0) SPair) + (applySing + (applySing + (singFun2 (Proxy :: Proxy PairSym0) SPair) + (applySing (singFun1 (Proxy :: Proxy JustSym0) SJust) SZero)) + SZero)) + SFalse + sPr + = applySing + (applySing + (singFun2 (Proxy :: Proxy PairSym0) SPair) + (applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) SZero)) + (applySing + (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SZero) SNil) + data instance Sing (z :: Pair a b) + = forall (n :: a) (n :: b). z ~ Pair n n => + SPair (Sing (n :: a)) (Sing (n :: b)) + type SPair = (Sing :: Pair a b -> GHC.Types.Type) + instance (SingKind (KProxy :: KProxy a), + SingKind (KProxy :: KProxy b)) => + SingKind (KProxy :: KProxy (Pair a b)) where + type DemoteRep (KProxy :: KProxy (Pair a b)) = Pair (DemoteRep (KProxy :: KProxy a)) (DemoteRep (KProxy :: KProxy b)) + fromSing (SPair b b) = Pair (fromSing b) (fromSing b) + toSing (Pair b b) + = case + GHC.Tuple.(,) + (toSing b :: SomeSing (KProxy :: KProxy a)) + (toSing b :: SomeSing (KProxy :: KProxy b)) + of { + GHC.Tuple.(,) (SomeSing c) (SomeSing c) -> SomeSing (SPair c c) } + instance (SingI n, SingI n) => SingI (Pair (n :: a) (n :: b)) where + sing = SPair sing sing diff --git a/tests/compile-and-dump/Singletons/Empty.ghc80.template b/tests/compile-and-dump/Singletons/Empty.ghc80.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/Empty.ghc80.template @@ -0,0 +1,14 @@ +Singletons/Empty.hs:(0,0)-(0,0): Splicing declarations + singletons [d| data Empty |] + ======> + data Empty + data instance Sing (z :: Empty) + type SEmpty = (Sing :: Empty -> GHC.Types.Type) + instance SingKind (KProxy :: KProxy Empty) where + type DemoteRep (KProxy :: KProxy Empty) = Empty + fromSing z + = case z of { + _ -> error "Empty case reached -- this should be impossible" } + toSing z + = case z of { + _ -> error "Empty case reached -- this should be impossible" } diff --git a/tests/compile-and-dump/Singletons/EnumDeriving.ghc710.template b/tests/compile-and-dump/Singletons/EnumDeriving.ghc710.template --- a/tests/compile-and-dump/Singletons/EnumDeriving.ghc710.template +++ b/tests/compile-and-dump/Singletons/EnumDeriving.ghc710.template @@ -84,7 +84,7 @@ sToEnum sN = let lambda :: - forall n. t0 ~ n => Sing n -> Sing (Apply ToEnumSym0 n :: Foo) + forall n. t0 ~ n => Sing n -> Sing (Apply ToEnumSym0 t0 :: Foo) lambda n = case applySing @@ -95,14 +95,14 @@ -> let lambda :: TrueSym0 ~ Apply (Apply (:==$) n) (FromInteger 0) => - Sing (Case_0123456789 n TrueSym0) + Sing (Case_0123456789 n TrueSym0 :: Foo) lambda = SBar in lambda SFalse -> let lambda :: FalseSym0 ~ Apply (Apply (:==$) n) (FromInteger 0) => - Sing (Case_0123456789 n FalseSym0) + Sing (Case_0123456789 n FalseSym0 :: Foo) lambda = case applySing @@ -113,14 +113,14 @@ -> let lambda :: TrueSym0 ~ Apply (Apply (:==$) n) (FromInteger 1) => - Sing (Case_0123456789 n TrueSym0) + Sing (Case_0123456789 n TrueSym0 :: Foo) lambda = SBaz in lambda SFalse -> let lambda :: FalseSym0 ~ Apply (Apply (:==$) n) (FromInteger 1) => - Sing (Case_0123456789 n FalseSym0) + Sing (Case_0123456789 n FalseSym0 :: Foo) lambda = case applySing @@ -132,42 +132,39 @@ -> let lambda :: TrueSym0 ~ Apply (Apply (:==$) n) (FromInteger 2) => - Sing (Case_0123456789 n TrueSym0) + Sing (Case_0123456789 n TrueSym0 :: Foo) lambda = SBum in lambda SFalse -> let lambda :: FalseSym0 ~ Apply (Apply (:==$) n) (FromInteger 2) => - Sing (Case_0123456789 n FalseSym0) + Sing (Case_0123456789 n FalseSym0 :: Foo) lambda = sError (sing :: Sing "toEnum: bad argument") in lambda } :: - Sing (Case_0123456789 n (Apply (Apply (:==$) n) (FromInteger 2))) + Sing (Case_0123456789 n (Apply (Apply (:==$) n) (FromInteger 2)) :: Foo) in lambda } :: - Sing (Case_0123456789 n (Apply (Apply (:==$) n) (FromInteger 1))) + Sing (Case_0123456789 n (Apply (Apply (:==$) n) (FromInteger 1)) :: Foo) in lambda } :: - Sing (Case_0123456789 n (Apply (Apply (:==$) n) (FromInteger 0))) + Sing (Case_0123456789 n (Apply (Apply (:==$) n) (FromInteger 0)) :: Foo) in lambda sN sFromEnum SBar = let lambda :: - t0 ~ BarSym0 => - Sing (Apply FromEnumSym0 BarSym0 :: GHC.TypeLits.Nat) + t0 ~ BarSym0 => Sing (Apply FromEnumSym0 t0 :: GHC.TypeLits.Nat) lambda = sFromInteger (sing :: Sing 0) in lambda sFromEnum SBaz = let lambda :: - t0 ~ BazSym0 => - Sing (Apply FromEnumSym0 BazSym0 :: GHC.TypeLits.Nat) + t0 ~ BazSym0 => Sing (Apply FromEnumSym0 t0 :: GHC.TypeLits.Nat) lambda = sFromInteger (sing :: Sing 1) in lambda sFromEnum SBum = let lambda :: - t0 ~ BumSym0 => - Sing (Apply FromEnumSym0 BumSym0 :: GHC.TypeLits.Nat) + t0 ~ BumSym0 => Sing (Apply FromEnumSym0 t0 :: GHC.TypeLits.Nat) lambda = sFromInteger (sing :: Sing 2) in lambda instance SingI Bar where @@ -230,7 +227,7 @@ sToEnum sN = let lambda :: - forall n. t0 ~ n => Sing n -> Sing (Apply ToEnumSym0 n :: Quux) + forall n. t0 ~ n => Sing n -> Sing (Apply ToEnumSym0 t0 :: Quux) lambda n = case applySing @@ -241,14 +238,14 @@ -> let lambda :: TrueSym0 ~ Apply (Apply (:==$) n) (FromInteger 0) => - Sing (Case_0123456789 n TrueSym0) + Sing (Case_0123456789 n TrueSym0 :: Quux) lambda = SQ1 in lambda SFalse -> let lambda :: FalseSym0 ~ Apply (Apply (:==$) n) (FromInteger 0) => - Sing (Case_0123456789 n FalseSym0) + Sing (Case_0123456789 n FalseSym0 :: Quux) lambda = case applySing @@ -259,29 +256,29 @@ -> let lambda :: TrueSym0 ~ Apply (Apply (:==$) n) (FromInteger 1) => - Sing (Case_0123456789 n TrueSym0) + Sing (Case_0123456789 n TrueSym0 :: Quux) lambda = SQ2 in lambda SFalse -> let lambda :: FalseSym0 ~ Apply (Apply (:==$) n) (FromInteger 1) => - Sing (Case_0123456789 n FalseSym0) + Sing (Case_0123456789 n FalseSym0 :: Quux) lambda = sError (sing :: Sing "toEnum: bad argument") in lambda } :: - Sing (Case_0123456789 n (Apply (Apply (:==$) n) (FromInteger 1))) + Sing (Case_0123456789 n (Apply (Apply (:==$) n) (FromInteger 1)) :: Quux) in lambda } :: - Sing (Case_0123456789 n (Apply (Apply (:==$) n) (FromInteger 0))) + Sing (Case_0123456789 n (Apply (Apply (:==$) n) (FromInteger 0)) :: Quux) in lambda sN sFromEnum SQ1 = let lambda :: - t0 ~ Q1Sym0 => Sing (Apply FromEnumSym0 Q1Sym0 :: GHC.TypeLits.Nat) + t0 ~ Q1Sym0 => Sing (Apply FromEnumSym0 t0 :: GHC.TypeLits.Nat) lambda = sFromInteger (sing :: Sing 0) in lambda sFromEnum SQ2 = let lambda :: - t0 ~ Q2Sym0 => Sing (Apply FromEnumSym0 Q2Sym0 :: GHC.TypeLits.Nat) + t0 ~ Q2Sym0 => Sing (Apply FromEnumSym0 t0 :: GHC.TypeLits.Nat) lambda = sFromInteger (sing :: Sing 1) in lambda diff --git a/tests/compile-and-dump/Singletons/EnumDeriving.ghc80.template b/tests/compile-and-dump/Singletons/EnumDeriving.ghc80.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/EnumDeriving.ghc80.template @@ -0,0 +1,284 @@ +Singletons/EnumDeriving.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| data Foo + = Bar | Baz | Bum + deriving (Enum) + data Quux = Q1 | Q2 |] + ======> + data Foo + = Bar | Baz | Bum + deriving (Enum) + data Quux = Q1 | Q2 + type BarSym0 = Bar + type BazSym0 = Baz + type BumSym0 = Bum + type Q1Sym0 = Q1 + type Q2Sym0 = Q2 + type family Case_0123456789 n t where + Case_0123456789 n True = BumSym0 + Case_0123456789 n False = Apply ErrorSym0 "toEnum: bad argument" + type family Case_0123456789 n t where + Case_0123456789 n True = BazSym0 + Case_0123456789 n False = Case_0123456789 n (Apply (Apply (:==$) n) (FromInteger 2)) + type family Case_0123456789 n t where + Case_0123456789 n True = BarSym0 + Case_0123456789 n False = Case_0123456789 n (Apply (Apply (:==$) n) (FromInteger 1)) + type family ToEnum_0123456789 (a :: GHC.Types.Nat) :: Foo where + ToEnum_0123456789 n = Case_0123456789 n (Apply (Apply (:==$) n) (FromInteger 0)) + type ToEnum_0123456789Sym1 (t :: GHC.Types.Nat) = + ToEnum_0123456789 t + instance SuppressUnusedWarnings ToEnum_0123456789Sym0 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) ToEnum_0123456789Sym0KindInference GHC.Tuple.()) + data ToEnum_0123456789Sym0 (l :: TyFun GHC.Types.Nat Foo) + = forall arg. KindOf (Apply ToEnum_0123456789Sym0 arg) ~ KindOf (ToEnum_0123456789Sym1 arg) => + ToEnum_0123456789Sym0KindInference + type instance Apply ToEnum_0123456789Sym0 l = ToEnum_0123456789Sym1 l + type family FromEnum_0123456789 (a :: Foo) :: GHC.Types.Nat where + FromEnum_0123456789 Bar = FromInteger 0 + FromEnum_0123456789 Baz = FromInteger 1 + FromEnum_0123456789 Bum = FromInteger 2 + type FromEnum_0123456789Sym1 (t :: Foo) = FromEnum_0123456789 t + instance SuppressUnusedWarnings FromEnum_0123456789Sym0 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) FromEnum_0123456789Sym0KindInference GHC.Tuple.()) + data FromEnum_0123456789Sym0 (l :: TyFun Foo GHC.Types.Nat) + = forall arg. KindOf (Apply FromEnum_0123456789Sym0 arg) ~ KindOf (FromEnum_0123456789Sym1 arg) => + FromEnum_0123456789Sym0KindInference + type instance Apply FromEnum_0123456789Sym0 l = FromEnum_0123456789Sym1 l + instance PEnum (KProxy :: KProxy Foo) where + type ToEnum (a :: GHC.Types.Nat) = Apply ToEnum_0123456789Sym0 a + type FromEnum (a :: Foo) = Apply FromEnum_0123456789Sym0 a + data instance Sing (z :: Foo) + = z ~ Bar => SBar | z ~ Baz => SBaz | z ~ Bum => SBum + type SFoo = (Sing :: Foo -> GHC.Types.Type) + instance SingKind (KProxy :: KProxy Foo) where + type DemoteRep (KProxy :: KProxy Foo) = Foo + fromSing SBar = Bar + fromSing SBaz = Baz + fromSing SBum = Bum + toSing Bar = SomeSing SBar + toSing Baz = SomeSing SBaz + toSing Bum = SomeSing SBum + data instance Sing (z :: Quux) = z ~ Q1 => SQ1 | z ~ Q2 => SQ2 + type SQuux = (Sing :: Quux -> GHC.Types.Type) + instance SingKind (KProxy :: KProxy Quux) where + type DemoteRep (KProxy :: KProxy Quux) = Quux + fromSing SQ1 = Q1 + fromSing SQ2 = Q2 + toSing Q1 = SomeSing SQ1 + toSing Q2 = SomeSing SQ2 + instance SEnum (KProxy :: KProxy Foo) where + sToEnum :: + forall (t0 :: GHC.Types.Nat). + Sing t0 + -> Sing (Apply (ToEnumSym0 :: TyFun GHC.Types.Nat Foo + -> GHC.Types.Type) t0 :: Foo) + sFromEnum :: + forall (t0 :: Foo). + Sing t0 + -> Sing (Apply (FromEnumSym0 :: TyFun Foo GHC.Types.Nat + -> GHC.Types.Type) t0 :: GHC.Types.Nat) + sToEnum sN + = let + lambda :: + forall n. t0 ~ n => Sing n -> Sing (Apply ToEnumSym0 t0 :: Foo) + lambda n + = case + applySing + (applySing (singFun2 (Proxy :: Proxy (:==$)) (%:==)) n) + (sFromInteger (sing :: Sing 0)) + of { + STrue + -> let + lambda :: + TrueSym0 ~ Apply (Apply (:==$) n) (FromInteger 0) => + Sing (Case_0123456789 n TrueSym0 :: Foo) + lambda = SBar + in lambda + SFalse + -> let + lambda :: + FalseSym0 ~ Apply (Apply (:==$) n) (FromInteger 0) => + Sing (Case_0123456789 n FalseSym0 :: Foo) + lambda + = case + applySing + (applySing (singFun2 (Proxy :: Proxy (:==$)) (%:==)) n) + (sFromInteger (sing :: Sing 1)) + of { + STrue + -> let + lambda :: + TrueSym0 ~ Apply (Apply (:==$) n) (FromInteger 1) => + Sing (Case_0123456789 n TrueSym0 :: Foo) + lambda = SBaz + in lambda + SFalse + -> let + lambda :: + FalseSym0 ~ Apply (Apply (:==$) n) (FromInteger 1) => + Sing (Case_0123456789 n FalseSym0 :: Foo) + lambda + = case + applySing + (applySing + (singFun2 (Proxy :: Proxy (:==$)) (%:==)) n) + (sFromInteger (sing :: Sing 2)) + of { + STrue + -> let + lambda :: + TrueSym0 ~ Apply (Apply (:==$) n) (FromInteger 2) => + Sing (Case_0123456789 n TrueSym0 :: Foo) + lambda = SBum + in lambda + SFalse + -> let + lambda :: + FalseSym0 ~ Apply (Apply (:==$) n) (FromInteger 2) => + Sing (Case_0123456789 n FalseSym0 :: Foo) + lambda + = sError (sing :: Sing "toEnum: bad argument") + in lambda } :: + Sing (Case_0123456789 n (Apply (Apply (:==$) n) (FromInteger 2)) :: Foo) + in lambda } :: + Sing (Case_0123456789 n (Apply (Apply (:==$) n) (FromInteger 1)) :: Foo) + in lambda } :: + Sing (Case_0123456789 n (Apply (Apply (:==$) n) (FromInteger 0)) :: Foo) + in lambda sN + sFromEnum SBar + = let + lambda :: + t0 ~ BarSym0 => Sing (Apply FromEnumSym0 t0 :: GHC.Types.Nat) + lambda = sFromInteger (sing :: Sing 0) + in lambda + sFromEnum SBaz + = let + lambda :: + t0 ~ BazSym0 => Sing (Apply FromEnumSym0 t0 :: GHC.Types.Nat) + lambda = sFromInteger (sing :: Sing 1) + in lambda + sFromEnum SBum + = let + lambda :: + t0 ~ BumSym0 => Sing (Apply FromEnumSym0 t0 :: GHC.Types.Nat) + lambda = sFromInteger (sing :: Sing 2) + in lambda + instance SingI Bar where + sing = SBar + instance SingI Baz where + sing = SBaz + instance SingI Bum where + sing = SBum + instance SingI Q1 where + sing = SQ1 + instance SingI Q2 where + sing = SQ2 +Singletons/EnumDeriving.hs:0:0:: Splicing declarations + singEnumInstance ''Quux + ======> + type family Case_0123456789 n t where + Case_0123456789 n True = Q2Sym0 + Case_0123456789 n False = Apply ErrorSym0 "toEnum: bad argument" + type family Case_0123456789 n t where + Case_0123456789 n True = Q1Sym0 + Case_0123456789 n False = Case_0123456789 n (Apply (Apply (:==$) n) (FromInteger 1)) + type family ToEnum_0123456789 (a :: GHC.Types.Nat) :: Quux where + ToEnum_0123456789 n = Case_0123456789 n (Apply (Apply (:==$) n) (FromInteger 0)) + type ToEnum_0123456789Sym1 (t :: GHC.Types.Nat) = + ToEnum_0123456789 t + instance SuppressUnusedWarnings ToEnum_0123456789Sym0 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) ToEnum_0123456789Sym0KindInference GHC.Tuple.()) + data ToEnum_0123456789Sym0 (l :: TyFun GHC.Types.Nat Quux) + = forall arg. KindOf (Apply ToEnum_0123456789Sym0 arg) ~ KindOf (ToEnum_0123456789Sym1 arg) => + ToEnum_0123456789Sym0KindInference + type instance Apply ToEnum_0123456789Sym0 l = ToEnum_0123456789Sym1 l + type family FromEnum_0123456789 (a :: Quux) :: GHC.Types.Nat where + FromEnum_0123456789 Q1 = FromInteger 0 + FromEnum_0123456789 Q2 = FromInteger 1 + type FromEnum_0123456789Sym1 (t :: Quux) = FromEnum_0123456789 t + instance SuppressUnusedWarnings FromEnum_0123456789Sym0 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) FromEnum_0123456789Sym0KindInference GHC.Tuple.()) + data FromEnum_0123456789Sym0 (l :: TyFun Quux GHC.Types.Nat) + = forall arg. KindOf (Apply FromEnum_0123456789Sym0 arg) ~ KindOf (FromEnum_0123456789Sym1 arg) => + FromEnum_0123456789Sym0KindInference + type instance Apply FromEnum_0123456789Sym0 l = FromEnum_0123456789Sym1 l + instance PEnum (KProxy :: KProxy Quux) where + type ToEnum (a :: GHC.Types.Nat) = Apply ToEnum_0123456789Sym0 a + type FromEnum (a :: Quux) = Apply FromEnum_0123456789Sym0 a + instance SEnum (KProxy :: KProxy Quux) where + sToEnum :: + forall (t0 :: GHC.Types.Nat). + Sing t0 + -> Sing (Apply (ToEnumSym0 :: TyFun GHC.Types.Nat Quux + -> GHC.Types.Type) t0 :: Quux) + sFromEnum :: + forall (t0 :: Quux). + Sing t0 + -> Sing (Apply (FromEnumSym0 :: TyFun Quux GHC.Types.Nat + -> GHC.Types.Type) t0 :: GHC.Types.Nat) + sToEnum sN + = let + lambda :: + forall n. t0 ~ n => Sing n -> Sing (Apply ToEnumSym0 t0 :: Quux) + lambda n + = case + applySing + (applySing (singFun2 (Proxy :: Proxy (:==$)) (%:==)) n) + (sFromInteger (sing :: Sing 0)) + of { + STrue + -> let + lambda :: + TrueSym0 ~ Apply (Apply (:==$) n) (FromInteger 0) => + Sing (Case_0123456789 n TrueSym0 :: Quux) + lambda = SQ1 + in lambda + SFalse + -> let + lambda :: + FalseSym0 ~ Apply (Apply (:==$) n) (FromInteger 0) => + Sing (Case_0123456789 n FalseSym0 :: Quux) + lambda + = case + applySing + (applySing (singFun2 (Proxy :: Proxy (:==$)) (%:==)) n) + (sFromInteger (sing :: Sing 1)) + of { + STrue + -> let + lambda :: + TrueSym0 ~ Apply (Apply (:==$) n) (FromInteger 1) => + Sing (Case_0123456789 n TrueSym0 :: Quux) + lambda = SQ2 + in lambda + SFalse + -> let + lambda :: + FalseSym0 ~ Apply (Apply (:==$) n) (FromInteger 1) => + Sing (Case_0123456789 n FalseSym0 :: Quux) + lambda = sError (sing :: Sing "toEnum: bad argument") + in lambda } :: + Sing (Case_0123456789 n (Apply (Apply (:==$) n) (FromInteger 1)) :: Quux) + in lambda } :: + Sing (Case_0123456789 n (Apply (Apply (:==$) n) (FromInteger 0)) :: Quux) + in lambda sN + sFromEnum SQ1 + = let + lambda :: + t0 ~ Q1Sym0 => Sing (Apply FromEnumSym0 t0 :: GHC.Types.Nat) + lambda = sFromInteger (sing :: Sing 0) + in lambda + sFromEnum SQ2 + = let + lambda :: + t0 ~ Q2Sym0 => Sing (Apply FromEnumSym0 t0 :: GHC.Types.Nat) + lambda = sFromInteger (sing :: Sing 1) + in lambda diff --git a/tests/compile-and-dump/Singletons/EqInstances.ghc80.template b/tests/compile-and-dump/Singletons/EqInstances.ghc80.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/EqInstances.ghc80.template @@ -0,0 +1,23 @@ +Singletons/EqInstances.hs:0:0:: Splicing declarations + singEqInstances [''Foo, ''Empty] + ======> + instance SEq (KProxy :: KProxy Foo) where + (%:==) SFLeaf SFLeaf = STrue + (%:==) SFLeaf ((:%+:) _ _) = SFalse + (%:==) ((:%+:) _ _) SFLeaf = SFalse + (%:==) ((:%+:) a a) ((:%+:) b b) = (%:&&) ((%:==) a b) ((%:==) a b) + type family Equals_0123456789 (a :: Foo) (b :: Foo) :: Bool where + Equals_0123456789 FLeaf FLeaf = TrueSym0 + Equals_0123456789 ((:+:) a a) ((:+:) b b) = (:&&) ((:==) a b) ((:==) a b) + Equals_0123456789 (a :: Foo) (b :: Foo) = FalseSym0 + instance PEq (KProxy :: KProxy Foo) where + type (:==) (a :: Foo) (b :: Foo) = Equals_0123456789 a b + instance SEq (KProxy :: KProxy Empty) where + (%:==) a _ + = case a of { + _ -> error "Empty case reached -- this should be impossible" } + type family Equals_0123456789 (a :: Empty) + (b :: Empty) :: Bool where + Equals_0123456789 (a :: Empty) (b :: Empty) = FalseSym0 + instance PEq (KProxy :: KProxy Empty) where + type (:==) (a :: Empty) (b :: Empty) = Equals_0123456789 a b diff --git a/tests/compile-and-dump/Singletons/Error.ghc710.template b/tests/compile-and-dump/Singletons/Error.ghc710.template --- a/tests/compile-and-dump/Singletons/Error.ghc710.template +++ b/tests/compile-and-dump/Singletons/Error.ghc710.template @@ -7,11 +7,11 @@ head :: forall a. [a] -> a head (a GHC.Types.: _) = a head GHC.Types.[] = error "Data.Singletons.List.head: empty list" - type HeadSym1 (t :: [a]) = Head t + type HeadSym1 (t :: [a0123456789]) = Head t instance SuppressUnusedWarnings HeadSym0 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) HeadSym0KindInference GHC.Tuple.()) - data HeadSym0 (l :: TyFun [a] a) + data HeadSym0 (l :: TyFun [a0123456789] a0123456789) = forall arg. KindOf (Apply HeadSym0 arg) ~ KindOf (HeadSym1 arg) => HeadSym0KindInference type instance Apply HeadSym0 l = HeadSym1 l @@ -23,14 +23,12 @@ = let lambda :: forall a _z_0123456789. t ~ Apply (Apply (:$) a) _z_0123456789 => - Sing a - -> Sing _z_0123456789 - -> Sing (Apply HeadSym0 (Apply (Apply (:$) a) _z_0123456789) :: a) + Sing a -> Sing _z_0123456789 -> Sing (Apply HeadSym0 t :: a) lambda a _z_0123456789 = a in lambda sA _s_z_0123456789 sHead SNil = let - lambda :: t ~ '[] => Sing (Apply HeadSym0 '[] :: a) + lambda :: t ~ '[] => Sing (Apply HeadSym0 t :: a) lambda = sError (sing :: Sing "Data.Singletons.List.head: empty list") in lambda diff --git a/tests/compile-and-dump/Singletons/Error.ghc80.template b/tests/compile-and-dump/Singletons/Error.ghc80.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/Error.ghc80.template @@ -0,0 +1,35 @@ +Singletons/Error.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| head :: [a] -> a + head (a : _) = a + head [] = error "Data.Singletons.List.head: empty list" |] + ======> + head :: forall a. [a] -> a + head (a GHC.Types.: _) = a + head GHC.Types.[] = error "Data.Singletons.List.head: empty list" + type HeadSym1 (t :: [a0123456789]) = Head t + instance SuppressUnusedWarnings HeadSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) HeadSym0KindInference GHC.Tuple.()) + data HeadSym0 (l :: TyFun [a0123456789] a0123456789) + = forall arg. KindOf (Apply HeadSym0 arg) ~ KindOf (HeadSym1 arg) => + HeadSym0KindInference + type instance Apply HeadSym0 l = HeadSym1 l + type family Head (a :: [a]) :: a where + Head ((:) a _z_0123456789) = a + Head '[] = Apply ErrorSym0 "Data.Singletons.List.head: empty list" + sHead :: forall (t :: [a]). Sing t -> Sing (Apply HeadSym0 t :: a) + sHead (SCons sA _s_z_0123456789) + = let + lambda :: + forall a _z_0123456789. + t ~ Apply (Apply (:$) a) _z_0123456789 => + Sing a -> Sing _z_0123456789 -> Sing (Apply HeadSym0 t :: a) + lambda a _z_0123456789 = a + in lambda sA _s_z_0123456789 + sHead SNil + = let + lambda :: t ~ '[] => Sing (Apply HeadSym0 t :: a) + lambda + = sError (sing :: Sing "Data.Singletons.List.head: empty list") + in lambda diff --git a/tests/compile-and-dump/Singletons/Fixity.ghc710.template b/tests/compile-and-dump/Singletons/Fixity.ghc710.template --- a/tests/compile-and-dump/Singletons/Fixity.ghc710.template +++ b/tests/compile-and-dump/Singletons/Fixity.ghc710.template @@ -16,18 +16,20 @@ (====) :: forall a. a -> a -> a (====) a _ = a infix 4 ==== - type (:====$$$) (t :: a) (t :: a) = (:====) t t + type (:====$$$) (t :: a0123456789) (t :: a0123456789) = (:====) t t instance SuppressUnusedWarnings (:====$$) where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) (:====$$###) GHC.Tuple.()) - data (:====$$) (l :: a) (l :: TyFun a a) + data (:====$$) (l :: a0123456789) + (l :: TyFun a0123456789 a0123456789) = forall arg. KindOf (Apply ((:====$$) l) arg) ~ KindOf ((:====$$$) l arg) => :====$$### type instance Apply ((:====$$) l) l = (:====$$$) l l instance SuppressUnusedWarnings (:====$) where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) (:====$###) GHC.Tuple.()) - data (:====$) (l :: TyFun a (TyFun a a -> *)) + data (:====$) (l :: TyFun a0123456789 (TyFun a0123456789 a0123456789 + -> *)) = forall arg. KindOf (Apply (:====$) arg) ~ KindOf ((:====$$) arg) => :====$### type instance Apply (:====$) l = (:====$$) l @@ -35,18 +37,19 @@ (:====) a _z_0123456789 = a infix 4 :==== infix 4 :<=> - type (:<=>$$$) (t :: a) (t :: a) = (:<=>) t t + type (:<=>$$$) (t :: a0123456789) (t :: a0123456789) = (:<=>) t t instance SuppressUnusedWarnings (:<=>$$) where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) (:<=>$$###) GHC.Tuple.()) - data (:<=>$$) (l :: a) (l :: TyFun a Ordering) + data (:<=>$$) (l :: a0123456789) (l :: TyFun a0123456789 Ordering) = forall arg. KindOf (Apply ((:<=>$$) l) arg) ~ KindOf ((:<=>$$$) l arg) => :<=>$$### type instance Apply ((:<=>$$) l) l = (:<=>$$$) l l instance SuppressUnusedWarnings (:<=>$) where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) (:<=>$###) GHC.Tuple.()) - data (:<=>$) (l :: TyFun a (TyFun a Ordering -> *)) + data (:<=>$) (l :: TyFun a0123456789 (TyFun a0123456789 Ordering + -> *)) = forall arg. KindOf (Apply (:<=>$) arg) ~ KindOf ((:<=>$$) arg) => :<=>$### type instance Apply (:<=>$) l = (:<=>$$) l @@ -62,8 +65,7 @@ lambda :: forall a _z_0123456789. (t ~ a, t ~ _z_0123456789) => Sing a - -> Sing _z_0123456789 - -> Sing (Apply (Apply (:====$) a) _z_0123456789 :: a) + -> Sing _z_0123456789 -> Sing (Apply (Apply (:====$) t) t :: a) lambda a _z_0123456789 = a in lambda sA _s_z_0123456789 class kproxy ~ KProxy => SMyOrd (kproxy :: KProxy a) where diff --git a/tests/compile-and-dump/Singletons/Fixity.ghc80.template b/tests/compile-and-dump/Singletons/Fixity.ghc80.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/Fixity.ghc80.template @@ -0,0 +1,75 @@ +Singletons/Fixity.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| infix 4 ==== + infix 4 <=> + + (====) :: a -> a -> a + a ==== _ = a + + class MyOrd a where + (<=>) :: a -> a -> Ordering + infix 4 <=> |] + ======> + class MyOrd a where + (<=>) :: a -> a -> Ordering + infix 4 <=> + (====) :: forall a. a -> a -> a + (====) a _ = a + infix 4 ==== + type (:====$$$) (t :: a0123456789) (t :: a0123456789) = (:====) t t + instance SuppressUnusedWarnings (:====$$) where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) (:====$$###) GHC.Tuple.()) + data (:====$$) (l :: a0123456789) + (l :: TyFun a0123456789 a0123456789) + = forall arg. KindOf (Apply ((:====$$) l) arg) ~ KindOf ((:====$$$) l arg) => + (:====$$###) + type instance Apply ((:====$$) l) l = (:====$$$) l l + instance SuppressUnusedWarnings (:====$) where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) (:====$###) GHC.Tuple.()) + data (:====$) (l :: TyFun a0123456789 (TyFun a0123456789 a0123456789 + -> GHC.Types.Type)) + = forall arg. KindOf (Apply (:====$) arg) ~ KindOf ((:====$$) arg) => + (:====$###) + type instance Apply (:====$) l = (:====$$) l + type family (:====) (a :: a) (a :: a) :: a where + (:====) a _z_0123456789 = a + infix 4 :==== + infix 4 :<=> + type (:<=>$$$) (t :: a0123456789) (t :: a0123456789) = (:<=>) t t + instance SuppressUnusedWarnings (:<=>$$) where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) (:<=>$$###) GHC.Tuple.()) + data (:<=>$$) (l :: a0123456789) (l :: TyFun a0123456789 Ordering) + = forall arg. KindOf (Apply ((:<=>$$) l) arg) ~ KindOf ((:<=>$$$) l arg) => + (:<=>$$###) + type instance Apply ((:<=>$$) l) l = (:<=>$$$) l l + instance SuppressUnusedWarnings (:<=>$) where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) (:<=>$###) GHC.Tuple.()) + data (:<=>$) (l :: TyFun a0123456789 (TyFun a0123456789 Ordering + -> GHC.Types.Type)) + = forall arg. KindOf (Apply (:<=>$) arg) ~ KindOf ((:<=>$$) arg) => + (:<=>$###) + type instance Apply (:<=>$) l = (:<=>$$) l + class kproxy ~ KProxy => PMyOrd (kproxy :: KProxy a) where + type (:<=>) (arg :: a) (arg :: a) :: Ordering + infix 4 %:==== + infix 4 %:<=> + (%:====) :: + forall (t :: a) (t :: a). + Sing t -> Sing t -> Sing (Apply (Apply (:====$) t) t :: a) + (%:====) sA _s_z_0123456789 + = let + lambda :: + forall a _z_0123456789. + (t ~ a, t ~ _z_0123456789) => + Sing a + -> Sing _z_0123456789 -> Sing (Apply (Apply (:====$) t) t :: a) + lambda a _z_0123456789 = a + in lambda sA _s_z_0123456789 + class kproxy ~ KProxy => SMyOrd (kproxy :: KProxy a) where + (%:<=>) :: + forall (t :: a) (t :: a). + Sing t -> Sing t -> Sing (Apply (Apply (:<=>$) t) t :: Ordering) diff --git a/tests/compile-and-dump/Singletons/FunDeps.ghc710.template b/tests/compile-and-dump/Singletons/FunDeps.ghc710.template --- a/tests/compile-and-dump/Singletons/FunDeps.ghc710.template +++ b/tests/compile-and-dump/Singletons/FunDeps.ghc710.template @@ -22,19 +22,19 @@ type T1Sym0 = T1 type family T1 where T1 = Apply MethSym0 TrueSym0 - type MethSym1 (t :: a) = Meth t + type MethSym1 (t :: a0123456789) = Meth t instance SuppressUnusedWarnings MethSym0 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) MethSym0KindInference GHC.Tuple.()) - data MethSym0 (l :: TyFun a a) + data MethSym0 (l :: TyFun a0123456789 a0123456789) = forall arg. KindOf (Apply MethSym0 arg) ~ KindOf (MethSym1 arg) => MethSym0KindInference type instance Apply MethSym0 l = MethSym1 l - type L2rSym1 (t :: a) = L2r t + type L2rSym1 (t :: a0123456789) = L2r t instance SuppressUnusedWarnings L2rSym0 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) L2rSym0KindInference GHC.Tuple.()) - data L2rSym0 (l :: TyFun a b) + data L2rSym0 (l :: TyFun a0123456789 b0123456789) = forall arg. KindOf (Apply L2rSym0 arg) ~ KindOf (L2rSym1 arg) => L2rSym0KindInference type instance Apply L2rSym0 l = L2rSym1 l @@ -82,17 +82,17 @@ = let lambda :: forall a_0123456789. t ~ a_0123456789 => - Sing a_0123456789 -> Sing (Apply MethSym0 a_0123456789 :: Bool) + Sing a_0123456789 -> Sing (Apply MethSym0 t :: Bool) lambda a_0123456789 = applySing (singFun1 (Proxy :: Proxy NotSym0) sNot) a_0123456789 in lambda sA_0123456789 sL2r SFalse = let - lambda :: t ~ FalseSym0 => Sing (Apply L2rSym0 FalseSym0 :: Nat) + lambda :: t ~ FalseSym0 => Sing (Apply L2rSym0 t :: Nat) lambda = sFromInteger (sing :: Sing 0) in lambda sL2r STrue = let - lambda :: t ~ TrueSym0 => Sing (Apply L2rSym0 TrueSym0 :: Nat) + lambda :: t ~ TrueSym0 => Sing (Apply L2rSym0 t :: Nat) lambda = sFromInteger (sing :: Sing 1) in lambda diff --git a/tests/compile-and-dump/Singletons/FunDeps.ghc80.template b/tests/compile-and-dump/Singletons/FunDeps.ghc80.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/FunDeps.ghc80.template @@ -0,0 +1,99 @@ +Singletons/FunDeps.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| t1 = meth True + + class FD a b | a -> b where + meth :: a -> a + l2r :: a -> b + + instance FD Bool Nat where + meth = not + l2r False = 0 + l2r True = 1 |] + ======> + class FD a b | a -> b where + meth :: a -> a + l2r :: a -> b + instance FD Bool Nat where + meth = not + l2r False = 0 + l2r True = 1 + t1 = meth True + type T1Sym0 = T1 + type family T1 where + T1 = Apply MethSym0 TrueSym0 + type MethSym1 (t :: a0123456789) = Meth t + instance SuppressUnusedWarnings MethSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) MethSym0KindInference GHC.Tuple.()) + data MethSym0 (l :: TyFun a0123456789 a0123456789) + = forall arg. KindOf (Apply MethSym0 arg) ~ KindOf (MethSym1 arg) => + MethSym0KindInference + type instance Apply MethSym0 l = MethSym1 l + type L2rSym1 (t :: a0123456789) = L2r t + instance SuppressUnusedWarnings L2rSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) L2rSym0KindInference GHC.Tuple.()) + data L2rSym0 (l :: TyFun a0123456789 b0123456789) + = forall arg. KindOf (Apply L2rSym0 arg) ~ KindOf (L2rSym1 arg) => + L2rSym0KindInference + type instance Apply L2rSym0 l = L2rSym1 l + class (kproxy ~ KProxy, + kproxy ~ KProxy) => PFD (kproxy :: KProxy a) + (kproxy :: KProxy b) | a -> b where + type Meth (arg :: a) :: a + type L2r (arg :: a) :: b + type family Meth_0123456789 (a :: Bool) :: Bool where + Meth_0123456789 a_0123456789 = Apply NotSym0 a_0123456789 + type Meth_0123456789Sym1 (t :: Bool) = Meth_0123456789 t + instance SuppressUnusedWarnings Meth_0123456789Sym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Meth_0123456789Sym0KindInference GHC.Tuple.()) + data Meth_0123456789Sym0 (l :: TyFun Bool Bool) + = forall arg. KindOf (Apply Meth_0123456789Sym0 arg) ~ KindOf (Meth_0123456789Sym1 arg) => + Meth_0123456789Sym0KindInference + type instance Apply Meth_0123456789Sym0 l = Meth_0123456789Sym1 l + type family L2r_0123456789 (a :: Bool) :: Nat where + L2r_0123456789 False = FromInteger 0 + L2r_0123456789 True = FromInteger 1 + type L2r_0123456789Sym1 (t :: Bool) = L2r_0123456789 t + instance SuppressUnusedWarnings L2r_0123456789Sym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) L2r_0123456789Sym0KindInference GHC.Tuple.()) + data L2r_0123456789Sym0 (l :: TyFun Bool Nat) + = forall arg. KindOf (Apply L2r_0123456789Sym0 arg) ~ KindOf (L2r_0123456789Sym1 arg) => + L2r_0123456789Sym0KindInference + type instance Apply L2r_0123456789Sym0 l = L2r_0123456789Sym1 l + instance PFD (KProxy :: KProxy Bool) (KProxy :: KProxy Nat) where + type Meth (a :: Bool) = Apply Meth_0123456789Sym0 a + type L2r (a :: Bool) = Apply L2r_0123456789Sym0 a + sT1 :: Sing T1Sym0 + sT1 = applySing (singFun1 (Proxy :: Proxy MethSym0) sMeth) STrue + class (kproxy ~ KProxy, + kproxy ~ KProxy) => SFD (kproxy :: KProxy a) + (kproxy :: KProxy b) | a -> b where + sMeth :: forall (t :: a). Sing t -> Sing (Apply MethSym0 t :: a) + sL2r :: forall (t :: a). Sing t -> Sing (Apply L2rSym0 t :: b) + instance SFD (KProxy :: KProxy Bool) (KProxy :: KProxy Nat) where + sMeth :: + forall (t :: Bool). Sing t -> Sing (Apply MethSym0 t :: Bool) + sL2r :: forall (t :: Bool). Sing t -> Sing (Apply L2rSym0 t :: Nat) + sMeth sA_0123456789 + = let + lambda :: + forall a_0123456789. + t ~ a_0123456789 => + Sing a_0123456789 -> Sing (Apply MethSym0 t :: Bool) + lambda a_0123456789 + = applySing (singFun1 (Proxy :: Proxy NotSym0) sNot) a_0123456789 + in lambda sA_0123456789 + sL2r SFalse + = let + lambda :: t ~ FalseSym0 => Sing (Apply L2rSym0 t :: Nat) + lambda = sFromInteger (sing :: Sing 0) + in lambda + sL2r STrue + = let + lambda :: t ~ TrueSym0 => Sing (Apply L2rSym0 t :: Nat) + lambda = sFromInteger (sing :: Sing 1) + in lambda diff --git a/tests/compile-and-dump/Singletons/HigherOrder.ghc710.template b/tests/compile-and-dump/Singletons/HigherOrder.ghc710.template --- a/tests/compile-and-dump/Singletons/HigherOrder.ghc710.template +++ b/tests/compile-and-dump/Singletons/HigherOrder.ghc710.template @@ -41,67 +41,27 @@ = zipWith (\ n b -> if b then Succ (Succ n) else n) ns bs etad :: [Nat] -> [Bool] -> [Nat] etad = zipWith (\ n b -> if b then Succ (Succ n) else n) - type LeftSym1 (t :: a) = Left t + type LeftSym1 (t :: a0123456789) = Left t instance SuppressUnusedWarnings LeftSym0 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) LeftSym0KindInference GHC.Tuple.()) - data LeftSym0 (l :: TyFun a (Either a b)) + data LeftSym0 (l :: TyFun a0123456789 (Either a0123456789 b0123456789)) = forall arg. KindOf (Apply LeftSym0 arg) ~ KindOf (LeftSym1 arg) => LeftSym0KindInference type instance Apply LeftSym0 l = LeftSym1 l - type RightSym1 (t :: b) = Right t + type RightSym1 (t :: b0123456789) = Right t instance SuppressUnusedWarnings RightSym0 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) RightSym0KindInference GHC.Tuple.()) - data RightSym0 (l :: TyFun b (Either a b)) + data RightSym0 (l :: TyFun b0123456789 (Either a0123456789 b0123456789)) = forall arg. KindOf (Apply RightSym0 arg) ~ KindOf (RightSym1 arg) => RightSym0KindInference type instance Apply RightSym0 l = RightSym1 l - type Let0123456789Scrutinee_0123456789Sym4 t t t t = - Let0123456789Scrutinee_0123456789 t t t t - instance SuppressUnusedWarnings Let0123456789Scrutinee_0123456789Sym3 where - suppressUnusedWarnings _ - = snd - (GHC.Tuple.(,) - Let0123456789Scrutinee_0123456789Sym3KindInference GHC.Tuple.()) - data Let0123456789Scrutinee_0123456789Sym3 l l l l - = forall arg. KindOf (Apply (Let0123456789Scrutinee_0123456789Sym3 l l l) arg) ~ KindOf (Let0123456789Scrutinee_0123456789Sym4 l l l arg) => - Let0123456789Scrutinee_0123456789Sym3KindInference - type instance Apply (Let0123456789Scrutinee_0123456789Sym3 l l l) l = Let0123456789Scrutinee_0123456789Sym4 l l l l - instance SuppressUnusedWarnings Let0123456789Scrutinee_0123456789Sym2 where - suppressUnusedWarnings _ - = snd - (GHC.Tuple.(,) - Let0123456789Scrutinee_0123456789Sym2KindInference GHC.Tuple.()) - data Let0123456789Scrutinee_0123456789Sym2 l l l - = forall arg. KindOf (Apply (Let0123456789Scrutinee_0123456789Sym2 l l) arg) ~ KindOf (Let0123456789Scrutinee_0123456789Sym3 l l arg) => - Let0123456789Scrutinee_0123456789Sym2KindInference - type instance Apply (Let0123456789Scrutinee_0123456789Sym2 l l) l = Let0123456789Scrutinee_0123456789Sym3 l l l - instance SuppressUnusedWarnings Let0123456789Scrutinee_0123456789Sym1 where - suppressUnusedWarnings _ - = snd - (GHC.Tuple.(,) - Let0123456789Scrutinee_0123456789Sym1KindInference GHC.Tuple.()) - data Let0123456789Scrutinee_0123456789Sym1 l l - = forall arg. KindOf (Apply (Let0123456789Scrutinee_0123456789Sym1 l) arg) ~ KindOf (Let0123456789Scrutinee_0123456789Sym2 l arg) => - Let0123456789Scrutinee_0123456789Sym1KindInference - type instance Apply (Let0123456789Scrutinee_0123456789Sym1 l) l = Let0123456789Scrutinee_0123456789Sym2 l l - instance SuppressUnusedWarnings Let0123456789Scrutinee_0123456789Sym0 where - suppressUnusedWarnings _ - = snd - (GHC.Tuple.(,) - Let0123456789Scrutinee_0123456789Sym0KindInference GHC.Tuple.()) - data Let0123456789Scrutinee_0123456789Sym0 l - = forall arg. KindOf (Apply Let0123456789Scrutinee_0123456789Sym0 arg) ~ KindOf (Let0123456789Scrutinee_0123456789Sym1 arg) => - Let0123456789Scrutinee_0123456789Sym0KindInference - type instance Apply Let0123456789Scrutinee_0123456789Sym0 l = Let0123456789Scrutinee_0123456789Sym1 l - type family Let0123456789Scrutinee_0123456789 ns bs n b where - Let0123456789Scrutinee_0123456789 ns bs n b = b type family Case_0123456789 ns bs n b t where Case_0123456789 ns bs n b True = Apply SuccSym0 (Apply SuccSym0 n) Case_0123456789 ns bs n b False = n type family Lambda_0123456789 ns bs t t where - Lambda_0123456789 ns bs n b = Case_0123456789 ns bs n b (Let0123456789Scrutinee_0123456789Sym4 ns bs n b) + Lambda_0123456789 ns bs n b = Case_0123456789 ns bs n b b type Lambda_0123456789Sym4 t t t t = Lambda_0123456789 t t t t instance SuppressUnusedWarnings Lambda_0123456789Sym3 where suppressUnusedWarnings _ @@ -135,54 +95,11 @@ = forall arg. KindOf (Apply Lambda_0123456789Sym0 arg) ~ KindOf (Lambda_0123456789Sym1 arg) => Lambda_0123456789Sym0KindInference type instance Apply Lambda_0123456789Sym0 l = Lambda_0123456789Sym1 l - type Let0123456789Scrutinee_0123456789Sym4 t t t t = - Let0123456789Scrutinee_0123456789 t t t t - instance SuppressUnusedWarnings Let0123456789Scrutinee_0123456789Sym3 where - suppressUnusedWarnings _ - = snd - (GHC.Tuple.(,) - Let0123456789Scrutinee_0123456789Sym3KindInference GHC.Tuple.()) - data Let0123456789Scrutinee_0123456789Sym3 l l l l - = forall arg. KindOf (Apply (Let0123456789Scrutinee_0123456789Sym3 l l l) arg) ~ KindOf (Let0123456789Scrutinee_0123456789Sym4 l l l arg) => - Let0123456789Scrutinee_0123456789Sym3KindInference - type instance Apply (Let0123456789Scrutinee_0123456789Sym3 l l l) l = Let0123456789Scrutinee_0123456789Sym4 l l l l - instance SuppressUnusedWarnings Let0123456789Scrutinee_0123456789Sym2 where - suppressUnusedWarnings _ - = snd - (GHC.Tuple.(,) - Let0123456789Scrutinee_0123456789Sym2KindInference GHC.Tuple.()) - data Let0123456789Scrutinee_0123456789Sym2 l l l - = forall arg. KindOf (Apply (Let0123456789Scrutinee_0123456789Sym2 l l) arg) ~ KindOf (Let0123456789Scrutinee_0123456789Sym3 l l arg) => - Let0123456789Scrutinee_0123456789Sym2KindInference - type instance Apply (Let0123456789Scrutinee_0123456789Sym2 l l) l = Let0123456789Scrutinee_0123456789Sym3 l l l - instance SuppressUnusedWarnings Let0123456789Scrutinee_0123456789Sym1 where - suppressUnusedWarnings _ - = snd - (GHC.Tuple.(,) - Let0123456789Scrutinee_0123456789Sym1KindInference GHC.Tuple.()) - data Let0123456789Scrutinee_0123456789Sym1 l l - = forall arg. KindOf (Apply (Let0123456789Scrutinee_0123456789Sym1 l) arg) ~ KindOf (Let0123456789Scrutinee_0123456789Sym2 l arg) => - Let0123456789Scrutinee_0123456789Sym1KindInference - type instance Apply (Let0123456789Scrutinee_0123456789Sym1 l) l = Let0123456789Scrutinee_0123456789Sym2 l l - instance SuppressUnusedWarnings Let0123456789Scrutinee_0123456789Sym0 where - suppressUnusedWarnings _ - = snd - (GHC.Tuple.(,) - Let0123456789Scrutinee_0123456789Sym0KindInference GHC.Tuple.()) - data Let0123456789Scrutinee_0123456789Sym0 l - = forall arg. KindOf (Apply Let0123456789Scrutinee_0123456789Sym0 arg) ~ KindOf (Let0123456789Scrutinee_0123456789Sym1 arg) => - Let0123456789Scrutinee_0123456789Sym0KindInference - type instance Apply Let0123456789Scrutinee_0123456789Sym0 l = Let0123456789Scrutinee_0123456789Sym1 l - type family Let0123456789Scrutinee_0123456789 n - b - a_0123456789 - a_0123456789 where - Let0123456789Scrutinee_0123456789 n b a_0123456789 a_0123456789 = b type family Case_0123456789 n b a_0123456789 a_0123456789 t where Case_0123456789 n b a_0123456789 a_0123456789 True = Apply SuccSym0 (Apply SuccSym0 n) Case_0123456789 n b a_0123456789 a_0123456789 False = n type family Lambda_0123456789 a_0123456789 a_0123456789 t t where - Lambda_0123456789 a_0123456789 a_0123456789 n b = Case_0123456789 n b a_0123456789 a_0123456789 (Let0123456789Scrutinee_0123456789Sym4 n b a_0123456789 a_0123456789) + Lambda_0123456789 a_0123456789 a_0123456789 n b = Case_0123456789 n b a_0123456789 a_0123456789 b type Lambda_0123456789Sym4 t t t t = Lambda_0123456789 t t t t instance SuppressUnusedWarnings Lambda_0123456789Sym3 where suppressUnusedWarnings _ @@ -216,61 +133,80 @@ = forall arg. KindOf (Apply Lambda_0123456789Sym0 arg) ~ KindOf (Lambda_0123456789Sym1 arg) => Lambda_0123456789Sym0KindInference type instance Apply Lambda_0123456789Sym0 l = Lambda_0123456789Sym1 l - type FooSym3 (t :: TyFun (TyFun a b -> *) (TyFun a b -> *) -> *) - (t :: TyFun a b -> *) - (t :: a) = + type FooSym3 (t :: TyFun (TyFun a0123456789 b0123456789 + -> *) (TyFun a0123456789 b0123456789 -> *) + -> *) + (t :: TyFun a0123456789 b0123456789 -> *) + (t :: a0123456789) = Foo t t t instance SuppressUnusedWarnings FooSym2 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) FooSym2KindInference GHC.Tuple.()) - data FooSym2 (l :: TyFun (TyFun a b -> *) (TyFun a b -> *) -> *) - (l :: TyFun a b -> *) - (l :: TyFun a b) + data FooSym2 (l :: TyFun (TyFun a0123456789 b0123456789 + -> *) (TyFun a0123456789 b0123456789 -> *) + -> *) + (l :: TyFun a0123456789 b0123456789 -> *) + (l :: TyFun a0123456789 b0123456789) = forall arg. KindOf (Apply (FooSym2 l l) arg) ~ KindOf (FooSym3 l l arg) => FooSym2KindInference type instance Apply (FooSym2 l l) l = FooSym3 l l l instance SuppressUnusedWarnings FooSym1 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) FooSym1KindInference GHC.Tuple.()) - data FooSym1 (l :: TyFun (TyFun a b -> *) (TyFun a b -> *) -> *) - (l :: TyFun (TyFun a b -> *) (TyFun a b -> *)) + data FooSym1 (l :: TyFun (TyFun a0123456789 b0123456789 + -> *) (TyFun a0123456789 b0123456789 -> *) + -> *) + (l :: TyFun (TyFun a0123456789 b0123456789 + -> *) (TyFun a0123456789 b0123456789 -> *)) = forall arg. KindOf (Apply (FooSym1 l) arg) ~ KindOf (FooSym2 l arg) => FooSym1KindInference type instance Apply (FooSym1 l) l = FooSym2 l l instance SuppressUnusedWarnings FooSym0 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) FooSym0KindInference GHC.Tuple.()) - data FooSym0 (l :: TyFun (TyFun (TyFun a b -> *) (TyFun a b -> *) - -> *) (TyFun (TyFun a b -> *) (TyFun a b -> *) -> *)) + data FooSym0 (l :: TyFun (TyFun (TyFun a0123456789 b0123456789 + -> *) (TyFun a0123456789 b0123456789 -> *) + -> *) (TyFun (TyFun a0123456789 b0123456789 + -> *) (TyFun a0123456789 b0123456789 -> *) + -> *)) = forall arg. KindOf (Apply FooSym0 arg) ~ KindOf (FooSym1 arg) => FooSym0KindInference type instance Apply FooSym0 l = FooSym1 l - type ZipWithSym3 (t :: TyFun a (TyFun b c -> *) -> *) - (t :: [a]) - (t :: [b]) = + type ZipWithSym3 (t :: TyFun a0123456789 (TyFun b0123456789 c0123456789 + -> *) + -> *) + (t :: [a0123456789]) + (t :: [b0123456789]) = ZipWith t t t instance SuppressUnusedWarnings ZipWithSym2 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) ZipWithSym2KindInference GHC.Tuple.()) - data ZipWithSym2 (l :: TyFun a (TyFun b c -> *) -> *) - (l :: [a]) - (l :: TyFun [b] [c]) + data ZipWithSym2 (l :: TyFun a0123456789 (TyFun b0123456789 c0123456789 + -> *) + -> *) + (l :: [a0123456789]) + (l :: TyFun [b0123456789] [c0123456789]) = forall arg. KindOf (Apply (ZipWithSym2 l l) arg) ~ KindOf (ZipWithSym3 l l arg) => ZipWithSym2KindInference type instance Apply (ZipWithSym2 l l) l = ZipWithSym3 l l l instance SuppressUnusedWarnings ZipWithSym1 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) ZipWithSym1KindInference GHC.Tuple.()) - data ZipWithSym1 (l :: TyFun a (TyFun b c -> *) -> *) - (l :: TyFun [a] (TyFun [b] [c] -> *)) + data ZipWithSym1 (l :: TyFun a0123456789 (TyFun b0123456789 c0123456789 + -> *) + -> *) + (l :: TyFun [a0123456789] (TyFun [b0123456789] [c0123456789] -> *)) = forall arg. KindOf (Apply (ZipWithSym1 l) arg) ~ KindOf (ZipWithSym2 l arg) => ZipWithSym1KindInference type instance Apply (ZipWithSym1 l) l = ZipWithSym2 l l instance SuppressUnusedWarnings ZipWithSym0 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) ZipWithSym0KindInference GHC.Tuple.()) - data ZipWithSym0 (l :: TyFun (TyFun a (TyFun b c -> *) - -> *) (TyFun [a] (TyFun [b] [c] -> *) -> *)) + data ZipWithSym0 (l :: TyFun (TyFun a0123456789 (TyFun b0123456789 c0123456789 + -> *) + -> *) (TyFun [a0123456789] (TyFun [b0123456789] [c0123456789] + -> *) + -> *)) = forall arg. KindOf (Apply ZipWithSym0 arg) ~ KindOf (ZipWithSym1 arg) => ZipWithSym0KindInference type instance Apply ZipWithSym0 l = ZipWithSym1 l @@ -304,36 +240,41 @@ = forall arg. KindOf (Apply EtadSym0 arg) ~ KindOf (EtadSym1 arg) => EtadSym0KindInference type instance Apply EtadSym0 l = EtadSym1 l - type LiftMaybeSym2 (t :: TyFun a b -> *) (t :: Maybe a) = + type LiftMaybeSym2 (t :: TyFun a0123456789 b0123456789 -> *) + (t :: Maybe a0123456789) = LiftMaybe t t instance SuppressUnusedWarnings LiftMaybeSym1 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) LiftMaybeSym1KindInference GHC.Tuple.()) - data LiftMaybeSym1 (l :: TyFun a b -> *) - (l :: TyFun (Maybe a) (Maybe b)) + data LiftMaybeSym1 (l :: TyFun a0123456789 b0123456789 -> *) + (l :: TyFun (Maybe a0123456789) (Maybe b0123456789)) = forall arg. KindOf (Apply (LiftMaybeSym1 l) arg) ~ KindOf (LiftMaybeSym2 l arg) => LiftMaybeSym1KindInference type instance Apply (LiftMaybeSym1 l) l = LiftMaybeSym2 l l instance SuppressUnusedWarnings LiftMaybeSym0 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) LiftMaybeSym0KindInference GHC.Tuple.()) - data LiftMaybeSym0 (l :: TyFun (TyFun a b - -> *) (TyFun (Maybe a) (Maybe b) -> *)) + data LiftMaybeSym0 (l :: TyFun (TyFun a0123456789 b0123456789 + -> *) (TyFun (Maybe a0123456789) (Maybe b0123456789) -> *)) = forall arg. KindOf (Apply LiftMaybeSym0 arg) ~ KindOf (LiftMaybeSym1 arg) => LiftMaybeSym0KindInference type instance Apply LiftMaybeSym0 l = LiftMaybeSym1 l - type MapSym2 (t :: TyFun a b -> *) (t :: [a]) = Map t t + type MapSym2 (t :: TyFun a0123456789 b0123456789 -> *) + (t :: [a0123456789]) = + Map t t instance SuppressUnusedWarnings MapSym1 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) MapSym1KindInference GHC.Tuple.()) - data MapSym1 (l :: TyFun a b -> *) (l :: TyFun [a] [b]) + data MapSym1 (l :: TyFun a0123456789 b0123456789 -> *) + (l :: TyFun [a0123456789] [b0123456789]) = forall arg. KindOf (Apply (MapSym1 l) arg) ~ KindOf (MapSym2 l arg) => MapSym1KindInference type instance Apply (MapSym1 l) l = MapSym2 l l instance SuppressUnusedWarnings MapSym0 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) MapSym0KindInference GHC.Tuple.()) - data MapSym0 (l :: TyFun (TyFun a b -> *) (TyFun [a] [b] -> *)) + data MapSym0 (l :: TyFun (TyFun a0123456789 b0123456789 + -> *) (TyFun [a0123456789] [b0123456789] -> *)) = forall arg. KindOf (Apply MapSym0 arg) ~ KindOf (MapSym1 arg) => MapSym0KindInference type instance Apply MapSym0 l = MapSym1 l @@ -390,7 +331,7 @@ forall f g a. (t ~ f, t ~ g, t ~ a) => Sing f -> Sing g - -> Sing a -> Sing (Apply (Apply (Apply FooSym0 f) g) a :: b) + -> Sing a -> Sing (Apply (Apply (Apply FooSym0 t) t) t :: b) lambda f g a = applySing (applySing f g) a in lambda sF sG sA sZipWith sF (SCons sX sXs) (SCons sY sYs) @@ -403,8 +344,7 @@ -> Sing x -> Sing xs -> Sing y - -> Sing ys - -> Sing (Apply (Apply (Apply ZipWithSym0 f) (Apply (Apply (:$) x) xs)) (Apply (Apply (:$) y) ys) :: [c]) + -> Sing ys -> Sing (Apply (Apply (Apply ZipWithSym0 t) t) t :: [c]) lambda f x xs y ys = applySing (applySing @@ -420,7 +360,7 @@ lambda :: forall _z_0123456789. (t ~ _z_0123456789, t ~ '[], t ~ '[]) => Sing _z_0123456789 - -> Sing (Apply (Apply (Apply ZipWithSym0 _z_0123456789) '[]) '[] :: [c]) + -> Sing (Apply (Apply (Apply ZipWithSym0 t) t) t :: [c]) lambda _z_0123456789 = SNil in lambda _s_z_0123456789 sZipWith @@ -437,7 +377,7 @@ Sing _z_0123456789 -> Sing _z_0123456789 -> Sing _z_0123456789 - -> Sing (Apply (Apply (Apply ZipWithSym0 _z_0123456789) (Apply (Apply (:$) _z_0123456789) _z_0123456789)) '[] :: [c]) + -> Sing (Apply (Apply (Apply ZipWithSym0 t) t) t :: [c]) lambda _z_0123456789 _z_0123456789 _z_0123456789 = SNil in lambda _s_z_0123456789 _s_z_0123456789 _s_z_0123456789 sZipWith @@ -454,15 +394,14 @@ Sing _z_0123456789 -> Sing _z_0123456789 -> Sing _z_0123456789 - -> Sing (Apply (Apply (Apply ZipWithSym0 _z_0123456789) '[]) (Apply (Apply (:$) _z_0123456789) _z_0123456789) :: [c]) + -> Sing (Apply (Apply (Apply ZipWithSym0 t) t) t :: [c]) lambda _z_0123456789 _z_0123456789 _z_0123456789 = SNil in lambda _s_z_0123456789 _s_z_0123456789 _s_z_0123456789 sSplunge sNs sBs = let lambda :: forall ns bs. (t ~ ns, t ~ bs) => - Sing ns - -> Sing bs -> Sing (Apply (Apply SplungeSym0 ns) bs :: [Nat]) + Sing ns -> Sing bs -> Sing (Apply (Apply SplungeSym0 t) t :: [Nat]) lambda ns bs = applySing (applySing @@ -478,32 +417,26 @@ -> Sing b -> Sing (Apply (Apply (Apply (Apply Lambda_0123456789Sym0 ns) bs) n) b) lambda n b - = let - sScrutinee_0123456789 :: - Sing (Let0123456789Scrutinee_0123456789Sym4 ns bs n b) - sScrutinee_0123456789 = b - in case sScrutinee_0123456789 of { - STrue - -> let - lambda :: - TrueSym0 ~ Let0123456789Scrutinee_0123456789Sym4 ns bs n b => - Sing (Case_0123456789 ns bs n b TrueSym0) - lambda - = applySing - (singFun1 (Proxy :: Proxy SuccSym0) SSucc) - (applySing - (singFun1 - (Proxy :: Proxy SuccSym0) SSucc) - n) - in lambda - SFalse - -> let - lambda :: - FalseSym0 ~ Let0123456789Scrutinee_0123456789Sym4 ns bs n b => - Sing (Case_0123456789 ns bs n b FalseSym0) - lambda = n - in lambda } :: - Sing (Case_0123456789 ns bs n b (Let0123456789Scrutinee_0123456789Sym4 ns bs n b)) + = case b of { + STrue + -> let + lambda :: + TrueSym0 ~ b => + Sing (Case_0123456789 ns bs n b TrueSym0) + lambda + = applySing + (singFun1 (Proxy :: Proxy SuccSym0) SSucc) + (applySing + (singFun1 (Proxy :: Proxy SuccSym0) SSucc) n) + in lambda + SFalse + -> let + lambda :: + FalseSym0 ~ b => + Sing (Case_0123456789 ns bs n b FalseSym0) + lambda = n + in lambda } :: + Sing (Case_0123456789 ns bs n b b) in lambda sN sB))) ns) bs @@ -514,8 +447,7 @@ forall a_0123456789 a_0123456789. (t ~ a_0123456789, t ~ a_0123456789) => Sing a_0123456789 - -> Sing a_0123456789 - -> Sing (Apply (Apply EtadSym0 a_0123456789) a_0123456789 :: [Nat]) + -> Sing a_0123456789 -> Sing (Apply (Apply EtadSym0 t) t :: [Nat]) lambda a_0123456789 a_0123456789 = applySing (applySing @@ -532,32 +464,26 @@ -> Sing b -> Sing (Apply (Apply (Apply (Apply Lambda_0123456789Sym0 a_0123456789) a_0123456789) n) b) lambda n b - = let - sScrutinee_0123456789 :: - Sing (Let0123456789Scrutinee_0123456789Sym4 n b a_0123456789 a_0123456789) - sScrutinee_0123456789 = b - in case sScrutinee_0123456789 of { - STrue - -> let - lambda :: - TrueSym0 ~ Let0123456789Scrutinee_0123456789Sym4 n b a_0123456789 a_0123456789 => - Sing (Case_0123456789 n b a_0123456789 a_0123456789 TrueSym0) - lambda - = applySing - (singFun1 (Proxy :: Proxy SuccSym0) SSucc) - (applySing - (singFun1 - (Proxy :: Proxy SuccSym0) SSucc) - n) - in lambda - SFalse - -> let - lambda :: - FalseSym0 ~ Let0123456789Scrutinee_0123456789Sym4 n b a_0123456789 a_0123456789 => - Sing (Case_0123456789 n b a_0123456789 a_0123456789 FalseSym0) - lambda = n - in lambda } :: - Sing (Case_0123456789 n b a_0123456789 a_0123456789 (Let0123456789Scrutinee_0123456789Sym4 n b a_0123456789 a_0123456789)) + = case b of { + STrue + -> let + lambda :: + TrueSym0 ~ b => + Sing (Case_0123456789 n b a_0123456789 a_0123456789 TrueSym0) + lambda + = applySing + (singFun1 (Proxy :: Proxy SuccSym0) SSucc) + (applySing + (singFun1 (Proxy :: Proxy SuccSym0) SSucc) n) + in lambda + SFalse + -> let + lambda :: + FalseSym0 ~ b => + Sing (Case_0123456789 n b a_0123456789 a_0123456789 FalseSym0) + lambda = n + in lambda } :: + Sing (Case_0123456789 n b a_0123456789 a_0123456789 b) in lambda sN sB))) a_0123456789) a_0123456789 @@ -567,8 +493,7 @@ lambda :: forall f x. (t ~ f, t ~ Apply JustSym0 x) => Sing f - -> Sing x - -> Sing (Apply (Apply LiftMaybeSym0 f) (Apply JustSym0 x) :: Maybe b) + -> Sing x -> Sing (Apply (Apply LiftMaybeSym0 t) t :: Maybe b) lambda f x = applySing (singFun1 (Proxy :: Proxy JustSym0) SJust) (applySing f x) @@ -578,15 +503,14 @@ lambda :: forall _z_0123456789. (t ~ _z_0123456789, t ~ NothingSym0) => Sing _z_0123456789 - -> Sing (Apply (Apply LiftMaybeSym0 _z_0123456789) NothingSym0 :: Maybe b) + -> Sing (Apply (Apply LiftMaybeSym0 t) t :: Maybe b) lambda _z_0123456789 = SNothing in lambda _s_z_0123456789 sMap _s_z_0123456789 SNil = let lambda :: forall _z_0123456789. (t ~ _z_0123456789, t ~ '[]) => - Sing _z_0123456789 - -> Sing (Apply (Apply MapSym0 _z_0123456789) '[] :: [b]) + Sing _z_0123456789 -> Sing (Apply (Apply MapSym0 t) t :: [b]) lambda _z_0123456789 = SNil in lambda _s_z_0123456789 sMap sF (SCons sH sT) @@ -594,9 +518,7 @@ lambda :: forall f h t. (t ~ f, t ~ Apply (Apply (:$) h) t) => Sing f - -> Sing h - -> Sing t - -> Sing (Apply (Apply MapSym0 f) (Apply (Apply (:$) h) t) :: [b]) + -> Sing h -> Sing t -> Sing (Apply (Apply MapSym0 t) t :: [b]) lambda f h t = applySing (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) (applySing f h)) diff --git a/tests/compile-and-dump/Singletons/HigherOrder.ghc80.template b/tests/compile-and-dump/Singletons/HigherOrder.ghc80.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/HigherOrder.ghc80.template @@ -0,0 +1,575 @@ +Singletons/HigherOrder.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| map :: (a -> b) -> [a] -> [b] + map _ [] = [] + map f (h : t) = (f h) : (map f t) + liftMaybe :: (a -> b) -> Maybe a -> Maybe b + liftMaybe f (Just x) = Just (f x) + liftMaybe _ Nothing = Nothing + zipWith :: (a -> b -> c) -> [a] -> [b] -> [c] + zipWith f (x : xs) (y : ys) = f x y : zipWith f xs ys + zipWith _ [] [] = [] + zipWith _ (_ : _) [] = [] + zipWith _ [] (_ : _) = [] + foo :: ((a -> b) -> a -> b) -> (a -> b) -> a -> b + foo f g a = f g a + splunge :: [Nat] -> [Bool] -> [Nat] + splunge ns bs + = zipWith (\ n b -> if b then Succ (Succ n) else n) ns bs + etad :: [Nat] -> [Bool] -> [Nat] + etad = zipWith (\ n b -> if b then Succ (Succ n) else n) + + data Either a b = Left a | Right b |] + ======> + data Either a b = Left a | Right b + map :: forall a b. (a -> b) -> [a] -> [b] + map _ GHC.Types.[] = [] + map f (h GHC.Types.: t) = ((f h) GHC.Types.: (map f t)) + liftMaybe :: forall a b. (a -> b) -> Maybe a -> Maybe b + liftMaybe f (Just x) = Just (f x) + liftMaybe _ Nothing = Nothing + zipWith :: forall a b c. (a -> b -> c) -> [a] -> [b] -> [c] + zipWith f (x GHC.Types.: xs) (y GHC.Types.: ys) + = ((f x y) GHC.Types.: (zipWith f xs ys)) + zipWith _ GHC.Types.[] GHC.Types.[] = [] + zipWith _ (_ GHC.Types.: _) GHC.Types.[] = [] + zipWith _ GHC.Types.[] (_ GHC.Types.: _) = [] + foo :: forall a b. ((a -> b) -> a -> b) -> (a -> b) -> a -> b + foo f g a = f g a + splunge :: [Nat] -> [Bool] -> [Nat] + splunge ns bs + = zipWith (\ n b -> if b then Succ (Succ n) else n) ns bs + etad :: [Nat] -> [Bool] -> [Nat] + etad = zipWith (\ n b -> if b then Succ (Succ n) else n) + type LeftSym1 (t :: a0123456789) = Left t + instance SuppressUnusedWarnings LeftSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) LeftSym0KindInference GHC.Tuple.()) + data LeftSym0 (l :: TyFun a0123456789 (Either a0123456789 b0123456789)) + = forall arg. KindOf (Apply LeftSym0 arg) ~ KindOf (LeftSym1 arg) => + LeftSym0KindInference + type instance Apply LeftSym0 l = LeftSym1 l + type RightSym1 (t :: b0123456789) = Right t + instance SuppressUnusedWarnings RightSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) RightSym0KindInference GHC.Tuple.()) + data RightSym0 (l :: TyFun b0123456789 (Either a0123456789 b0123456789)) + = forall arg. KindOf (Apply RightSym0 arg) ~ KindOf (RightSym1 arg) => + RightSym0KindInference + type instance Apply RightSym0 l = RightSym1 l + type family Case_0123456789 ns bs n b t where + Case_0123456789 ns bs n b True = Apply SuccSym0 (Apply SuccSym0 n) + Case_0123456789 ns bs n b False = n + type family Lambda_0123456789 ns bs t t where + Lambda_0123456789 ns bs n b = Case_0123456789 ns bs n b b + type Lambda_0123456789Sym4 t t t t = Lambda_0123456789 t t t t + instance SuppressUnusedWarnings Lambda_0123456789Sym3 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym3KindInference GHC.Tuple.()) + data Lambda_0123456789Sym3 l l l l + = forall arg. KindOf (Apply (Lambda_0123456789Sym3 l l l) arg) ~ KindOf (Lambda_0123456789Sym4 l l l arg) => + Lambda_0123456789Sym3KindInference + type instance Apply (Lambda_0123456789Sym3 l l l) l = Lambda_0123456789Sym4 l l l l + instance SuppressUnusedWarnings Lambda_0123456789Sym2 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym2KindInference GHC.Tuple.()) + data Lambda_0123456789Sym2 l l l + = forall arg. KindOf (Apply (Lambda_0123456789Sym2 l l) arg) ~ KindOf (Lambda_0123456789Sym3 l l arg) => + Lambda_0123456789Sym2KindInference + type instance Apply (Lambda_0123456789Sym2 l l) l = Lambda_0123456789Sym3 l l l + instance SuppressUnusedWarnings Lambda_0123456789Sym1 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym1KindInference GHC.Tuple.()) + data Lambda_0123456789Sym1 l l + = forall arg. KindOf (Apply (Lambda_0123456789Sym1 l) arg) ~ KindOf (Lambda_0123456789Sym2 l arg) => + Lambda_0123456789Sym1KindInference + type instance Apply (Lambda_0123456789Sym1 l) l = Lambda_0123456789Sym2 l l + instance SuppressUnusedWarnings Lambda_0123456789Sym0 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym0KindInference GHC.Tuple.()) + data Lambda_0123456789Sym0 l + = forall arg. KindOf (Apply Lambda_0123456789Sym0 arg) ~ KindOf (Lambda_0123456789Sym1 arg) => + Lambda_0123456789Sym0KindInference + type instance Apply Lambda_0123456789Sym0 l = Lambda_0123456789Sym1 l + type family Case_0123456789 n b a_0123456789 a_0123456789 t where + Case_0123456789 n b a_0123456789 a_0123456789 True = Apply SuccSym0 (Apply SuccSym0 n) + Case_0123456789 n b a_0123456789 a_0123456789 False = n + type family Lambda_0123456789 a_0123456789 a_0123456789 t t where + Lambda_0123456789 a_0123456789 a_0123456789 n b = Case_0123456789 n b a_0123456789 a_0123456789 b + type Lambda_0123456789Sym4 t t t t = Lambda_0123456789 t t t t + instance SuppressUnusedWarnings Lambda_0123456789Sym3 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym3KindInference GHC.Tuple.()) + data Lambda_0123456789Sym3 l l l l + = forall arg. KindOf (Apply (Lambda_0123456789Sym3 l l l) arg) ~ KindOf (Lambda_0123456789Sym4 l l l arg) => + Lambda_0123456789Sym3KindInference + type instance Apply (Lambda_0123456789Sym3 l l l) l = Lambda_0123456789Sym4 l l l l + instance SuppressUnusedWarnings Lambda_0123456789Sym2 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym2KindInference GHC.Tuple.()) + data Lambda_0123456789Sym2 l l l + = forall arg. KindOf (Apply (Lambda_0123456789Sym2 l l) arg) ~ KindOf (Lambda_0123456789Sym3 l l arg) => + Lambda_0123456789Sym2KindInference + type instance Apply (Lambda_0123456789Sym2 l l) l = Lambda_0123456789Sym3 l l l + instance SuppressUnusedWarnings Lambda_0123456789Sym1 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym1KindInference GHC.Tuple.()) + data Lambda_0123456789Sym1 l l + = forall arg. KindOf (Apply (Lambda_0123456789Sym1 l) arg) ~ KindOf (Lambda_0123456789Sym2 l arg) => + Lambda_0123456789Sym1KindInference + type instance Apply (Lambda_0123456789Sym1 l) l = Lambda_0123456789Sym2 l l + instance SuppressUnusedWarnings Lambda_0123456789Sym0 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym0KindInference GHC.Tuple.()) + data Lambda_0123456789Sym0 l + = forall arg. KindOf (Apply Lambda_0123456789Sym0 arg) ~ KindOf (Lambda_0123456789Sym1 arg) => + Lambda_0123456789Sym0KindInference + type instance Apply Lambda_0123456789Sym0 l = Lambda_0123456789Sym1 l + type FooSym3 (t :: TyFun (TyFun a0123456789 b0123456789 + -> GHC.Types.Type) (TyFun a0123456789 b0123456789 + -> GHC.Types.Type) + -> GHC.Types.Type) + (t :: TyFun a0123456789 b0123456789 -> GHC.Types.Type) + (t :: a0123456789) = + Foo t t t + instance SuppressUnusedWarnings FooSym2 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) FooSym2KindInference GHC.Tuple.()) + data FooSym2 (l :: TyFun (TyFun a0123456789 b0123456789 + -> GHC.Types.Type) (TyFun a0123456789 b0123456789 + -> GHC.Types.Type) + -> GHC.Types.Type) + (l :: TyFun a0123456789 b0123456789 -> GHC.Types.Type) + (l :: TyFun a0123456789 b0123456789) + = forall arg. KindOf (Apply (FooSym2 l l) arg) ~ KindOf (FooSym3 l l arg) => + FooSym2KindInference + type instance Apply (FooSym2 l l) l = FooSym3 l l l + instance SuppressUnusedWarnings FooSym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) FooSym1KindInference GHC.Tuple.()) + data FooSym1 (l :: TyFun (TyFun a0123456789 b0123456789 + -> GHC.Types.Type) (TyFun a0123456789 b0123456789 + -> GHC.Types.Type) + -> GHC.Types.Type) + (l :: TyFun (TyFun a0123456789 b0123456789 + -> GHC.Types.Type) (TyFun a0123456789 b0123456789 + -> GHC.Types.Type)) + = forall arg. KindOf (Apply (FooSym1 l) arg) ~ KindOf (FooSym2 l arg) => + FooSym1KindInference + type instance Apply (FooSym1 l) l = FooSym2 l l + instance SuppressUnusedWarnings FooSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) FooSym0KindInference GHC.Tuple.()) + data FooSym0 (l :: TyFun (TyFun (TyFun a0123456789 b0123456789 + -> GHC.Types.Type) (TyFun a0123456789 b0123456789 + -> GHC.Types.Type) + -> GHC.Types.Type) (TyFun (TyFun a0123456789 b0123456789 + -> GHC.Types.Type) (TyFun a0123456789 b0123456789 + -> GHC.Types.Type) + -> GHC.Types.Type)) + = forall arg. KindOf (Apply FooSym0 arg) ~ KindOf (FooSym1 arg) => + FooSym0KindInference + type instance Apply FooSym0 l = FooSym1 l + type ZipWithSym3 (t :: TyFun a0123456789 (TyFun b0123456789 c0123456789 + -> GHC.Types.Type) + -> GHC.Types.Type) + (t :: [a0123456789]) + (t :: [b0123456789]) = + ZipWith t t t + instance SuppressUnusedWarnings ZipWithSym2 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) ZipWithSym2KindInference GHC.Tuple.()) + data ZipWithSym2 (l :: TyFun a0123456789 (TyFun b0123456789 c0123456789 + -> GHC.Types.Type) + -> GHC.Types.Type) + (l :: [a0123456789]) + (l :: TyFun [b0123456789] [c0123456789]) + = forall arg. KindOf (Apply (ZipWithSym2 l l) arg) ~ KindOf (ZipWithSym3 l l arg) => + ZipWithSym2KindInference + type instance Apply (ZipWithSym2 l l) l = ZipWithSym3 l l l + instance SuppressUnusedWarnings ZipWithSym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) ZipWithSym1KindInference GHC.Tuple.()) + data ZipWithSym1 (l :: TyFun a0123456789 (TyFun b0123456789 c0123456789 + -> GHC.Types.Type) + -> GHC.Types.Type) + (l :: TyFun [a0123456789] (TyFun [b0123456789] [c0123456789] + -> GHC.Types.Type)) + = forall arg. KindOf (Apply (ZipWithSym1 l) arg) ~ KindOf (ZipWithSym2 l arg) => + ZipWithSym1KindInference + type instance Apply (ZipWithSym1 l) l = ZipWithSym2 l l + instance SuppressUnusedWarnings ZipWithSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) ZipWithSym0KindInference GHC.Tuple.()) + data ZipWithSym0 (l :: TyFun (TyFun a0123456789 (TyFun b0123456789 c0123456789 + -> GHC.Types.Type) + -> GHC.Types.Type) (TyFun [a0123456789] (TyFun [b0123456789] [c0123456789] + -> GHC.Types.Type) + -> GHC.Types.Type)) + = forall arg. KindOf (Apply ZipWithSym0 arg) ~ KindOf (ZipWithSym1 arg) => + ZipWithSym0KindInference + type instance Apply ZipWithSym0 l = ZipWithSym1 l + type SplungeSym2 (t :: [Nat]) (t :: [Bool]) = Splunge t t + instance SuppressUnusedWarnings SplungeSym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) SplungeSym1KindInference GHC.Tuple.()) + data SplungeSym1 (l :: [Nat]) (l :: TyFun [Bool] [Nat]) + = forall arg. KindOf (Apply (SplungeSym1 l) arg) ~ KindOf (SplungeSym2 l arg) => + SplungeSym1KindInference + type instance Apply (SplungeSym1 l) l = SplungeSym2 l l + instance SuppressUnusedWarnings SplungeSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) SplungeSym0KindInference GHC.Tuple.()) + data SplungeSym0 (l :: TyFun [Nat] (TyFun [Bool] [Nat] + -> GHC.Types.Type)) + = forall arg. KindOf (Apply SplungeSym0 arg) ~ KindOf (SplungeSym1 arg) => + SplungeSym0KindInference + type instance Apply SplungeSym0 l = SplungeSym1 l + type EtadSym2 (t :: [Nat]) (t :: [Bool]) = Etad t t + instance SuppressUnusedWarnings EtadSym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) EtadSym1KindInference GHC.Tuple.()) + data EtadSym1 (l :: [Nat]) (l :: TyFun [Bool] [Nat]) + = forall arg. KindOf (Apply (EtadSym1 l) arg) ~ KindOf (EtadSym2 l arg) => + EtadSym1KindInference + type instance Apply (EtadSym1 l) l = EtadSym2 l l + instance SuppressUnusedWarnings EtadSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) EtadSym0KindInference GHC.Tuple.()) + data EtadSym0 (l :: TyFun [Nat] (TyFun [Bool] [Nat] + -> GHC.Types.Type)) + = forall arg. KindOf (Apply EtadSym0 arg) ~ KindOf (EtadSym1 arg) => + EtadSym0KindInference + type instance Apply EtadSym0 l = EtadSym1 l + type LiftMaybeSym2 (t :: TyFun a0123456789 b0123456789 + -> GHC.Types.Type) + (t :: Maybe a0123456789) = + LiftMaybe t t + instance SuppressUnusedWarnings LiftMaybeSym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) LiftMaybeSym1KindInference GHC.Tuple.()) + data LiftMaybeSym1 (l :: TyFun a0123456789 b0123456789 + -> GHC.Types.Type) + (l :: TyFun (Maybe a0123456789) (Maybe b0123456789)) + = forall arg. KindOf (Apply (LiftMaybeSym1 l) arg) ~ KindOf (LiftMaybeSym2 l arg) => + LiftMaybeSym1KindInference + type instance Apply (LiftMaybeSym1 l) l = LiftMaybeSym2 l l + instance SuppressUnusedWarnings LiftMaybeSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) LiftMaybeSym0KindInference GHC.Tuple.()) + data LiftMaybeSym0 (l :: TyFun (TyFun a0123456789 b0123456789 + -> GHC.Types.Type) (TyFun (Maybe a0123456789) (Maybe b0123456789) + -> GHC.Types.Type)) + = forall arg. KindOf (Apply LiftMaybeSym0 arg) ~ KindOf (LiftMaybeSym1 arg) => + LiftMaybeSym0KindInference + type instance Apply LiftMaybeSym0 l = LiftMaybeSym1 l + type MapSym2 (t :: TyFun a0123456789 b0123456789 -> GHC.Types.Type) + (t :: [a0123456789]) = + Map t t + instance SuppressUnusedWarnings MapSym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) MapSym1KindInference GHC.Tuple.()) + data MapSym1 (l :: TyFun a0123456789 b0123456789 -> GHC.Types.Type) + (l :: TyFun [a0123456789] [b0123456789]) + = forall arg. KindOf (Apply (MapSym1 l) arg) ~ KindOf (MapSym2 l arg) => + MapSym1KindInference + type instance Apply (MapSym1 l) l = MapSym2 l l + instance SuppressUnusedWarnings MapSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) MapSym0KindInference GHC.Tuple.()) + data MapSym0 (l :: TyFun (TyFun a0123456789 b0123456789 + -> GHC.Types.Type) (TyFun [a0123456789] [b0123456789] + -> GHC.Types.Type)) + = forall arg. KindOf (Apply MapSym0 arg) ~ KindOf (MapSym1 arg) => + MapSym0KindInference + type instance Apply MapSym0 l = MapSym1 l + type family Foo (a :: TyFun (TyFun a b + -> GHC.Types.Type) (TyFun a b -> GHC.Types.Type) + -> GHC.Types.Type) + (a :: TyFun a b -> GHC.Types.Type) + (a :: a) :: b where + Foo f g a = Apply (Apply f g) a + type family ZipWith (a :: TyFun a (TyFun b c -> GHC.Types.Type) + -> GHC.Types.Type) + (a :: [a]) + (a :: [b]) :: [c] where + ZipWith f ((:) x xs) ((:) y ys) = Apply (Apply (:$) (Apply (Apply f x) y)) (Apply (Apply (Apply ZipWithSym0 f) xs) ys) + ZipWith _z_0123456789 '[] '[] = '[] + ZipWith _z_0123456789 ((:) _z_0123456789 _z_0123456789) '[] = '[] + ZipWith _z_0123456789 '[] ((:) _z_0123456789 _z_0123456789) = '[] + type family Splunge (a :: [Nat]) (a :: [Bool]) :: [Nat] where + Splunge ns bs = Apply (Apply (Apply ZipWithSym0 (Apply (Apply Lambda_0123456789Sym0 ns) bs)) ns) bs + type family Etad (a :: [Nat]) (a :: [Bool]) :: [Nat] where + Etad a_0123456789 a_0123456789 = Apply (Apply (Apply ZipWithSym0 (Apply (Apply Lambda_0123456789Sym0 a_0123456789) a_0123456789)) a_0123456789) a_0123456789 + type family LiftMaybe (a :: TyFun a b -> GHC.Types.Type) + (a :: Maybe a) :: Maybe b where + LiftMaybe f (Just x) = Apply JustSym0 (Apply f x) + LiftMaybe _z_0123456789 Nothing = NothingSym0 + type family Map (a :: TyFun a b -> GHC.Types.Type) + (a :: [a]) :: [b] where + Map _z_0123456789 '[] = '[] + Map f ((:) h t) = Apply (Apply (:$) (Apply f h)) (Apply (Apply MapSym0 f) t) + sFoo :: + forall (t :: TyFun (TyFun a b -> GHC.Types.Type) (TyFun a b + -> GHC.Types.Type) + -> GHC.Types.Type) + (t :: TyFun a b -> GHC.Types.Type) + (t :: a). + Sing t + -> Sing t + -> Sing t -> Sing (Apply (Apply (Apply FooSym0 t) t) t :: b) + sZipWith :: + forall (t :: TyFun a (TyFun b c -> GHC.Types.Type) + -> GHC.Types.Type) + (t :: [a]) + (t :: [b]). + 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 (t :: TyFun a b -> GHC.Types.Type) (t :: Maybe a). + Sing t + -> Sing t -> Sing (Apply (Apply LiftMaybeSym0 t) t :: Maybe b) + sMap :: + forall (t :: TyFun a b -> GHC.Types.Type) (t :: [a]). + Sing t -> Sing t -> Sing (Apply (Apply MapSym0 t) t :: [b]) + sFoo sF sG sA + = let + lambda :: + forall f g a. + (t ~ f, t ~ g, t ~ a) => + Sing f + -> Sing g + -> Sing a -> Sing (Apply (Apply (Apply FooSym0 t) t) t :: b) + lambda f g a = applySing (applySing f g) a + in lambda sF sG sA + sZipWith sF (SCons sX sXs) (SCons sY sYs) + = let + lambda :: + forall f x xs y ys. + (t ~ f, + t ~ Apply (Apply (:$) x) xs, + t ~ Apply (Apply (:$) y) ys) => + Sing f + -> Sing x + -> Sing xs + -> Sing y + -> Sing ys -> Sing (Apply (Apply (Apply ZipWithSym0 t) t) t :: [c]) + lambda f x xs y ys + = applySing + (applySing + (singFun2 (Proxy :: Proxy (:$)) SCons) + (applySing (applySing f x) y)) + (applySing + (applySing + (applySing (singFun3 (Proxy :: Proxy ZipWithSym0) sZipWith) f) xs) + ys) + in lambda sF sX sXs sY sYs + sZipWith _s_z_0123456789 SNil SNil + = let + lambda :: + forall _z_0123456789. + (t ~ _z_0123456789, t ~ '[], t ~ '[]) => + Sing _z_0123456789 + -> Sing (Apply (Apply (Apply ZipWithSym0 t) t) t :: [c]) + lambda _z_0123456789 = SNil + in lambda _s_z_0123456789 + sZipWith + _s_z_0123456789 + (SCons _s_z_0123456789 _s_z_0123456789) + SNil + = let + lambda :: + forall _z_0123456789 _z_0123456789 _z_0123456789. + (t ~ _z_0123456789, + t ~ Apply (Apply (:$) _z_0123456789) _z_0123456789, + t ~ '[]) => + Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing (Apply (Apply (Apply ZipWithSym0 t) t) t :: [c]) + lambda _z_0123456789 _z_0123456789 _z_0123456789 = SNil + in lambda _s_z_0123456789 _s_z_0123456789 _s_z_0123456789 + sZipWith + _s_z_0123456789 + SNil + (SCons _s_z_0123456789 _s_z_0123456789) + = let + lambda :: + forall _z_0123456789 _z_0123456789 _z_0123456789. + (t ~ _z_0123456789, + t ~ '[], + t ~ Apply (Apply (:$) _z_0123456789) _z_0123456789) => + Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing (Apply (Apply (Apply ZipWithSym0 t) t) t :: [c]) + lambda _z_0123456789 _z_0123456789 _z_0123456789 = SNil + in lambda _s_z_0123456789 _s_z_0123456789 _s_z_0123456789 + sSplunge sNs sBs + = let + lambda :: + forall ns bs. + (t ~ ns, t ~ bs) => + Sing ns -> Sing bs -> Sing (Apply (Apply SplungeSym0 t) t :: [Nat]) + lambda ns bs + = applySing + (applySing + (applySing + (singFun3 (Proxy :: Proxy ZipWithSym0) sZipWith) + (singFun2 + (Proxy :: Proxy (Apply (Apply Lambda_0123456789Sym0 ns) bs)) + (\ sN sB + -> let + lambda :: + forall n b. + Sing n + -> Sing b + -> Sing (Apply (Apply (Apply (Apply Lambda_0123456789Sym0 ns) bs) n) b) + lambda n b + = case b of { + STrue + -> let + lambda :: + TrueSym0 ~ b => + Sing (Case_0123456789 ns bs n b TrueSym0) + lambda + = applySing + (singFun1 (Proxy :: Proxy SuccSym0) SSucc) + (applySing + (singFun1 (Proxy :: Proxy SuccSym0) SSucc) n) + in lambda + SFalse + -> let + lambda :: + FalseSym0 ~ b => + Sing (Case_0123456789 ns bs n b FalseSym0) + lambda = n + in lambda } :: + Sing (Case_0123456789 ns bs n b b) + in lambda sN sB))) + ns) + bs + in lambda sNs sBs + sEtad sA_0123456789 sA_0123456789 + = let + lambda :: + forall a_0123456789 a_0123456789. + (t ~ a_0123456789, t ~ a_0123456789) => + Sing a_0123456789 + -> Sing a_0123456789 -> Sing (Apply (Apply EtadSym0 t) t :: [Nat]) + lambda a_0123456789 a_0123456789 + = applySing + (applySing + (applySing + (singFun3 (Proxy :: Proxy ZipWithSym0) sZipWith) + (singFun2 + (Proxy :: + Proxy (Apply (Apply Lambda_0123456789Sym0 a_0123456789) a_0123456789)) + (\ sN sB + -> let + lambda :: + forall n b. + Sing n + -> Sing b + -> Sing (Apply (Apply (Apply (Apply Lambda_0123456789Sym0 a_0123456789) a_0123456789) n) b) + lambda n b + = case b of { + STrue + -> let + lambda :: + TrueSym0 ~ b => + Sing (Case_0123456789 n b a_0123456789 a_0123456789 TrueSym0) + lambda + = applySing + (singFun1 (Proxy :: Proxy SuccSym0) SSucc) + (applySing + (singFun1 (Proxy :: Proxy SuccSym0) SSucc) n) + in lambda + SFalse + -> let + lambda :: + FalseSym0 ~ b => + Sing (Case_0123456789 n b a_0123456789 a_0123456789 FalseSym0) + lambda = n + in lambda } :: + Sing (Case_0123456789 n b a_0123456789 a_0123456789 b) + in lambda sN sB))) + a_0123456789) + a_0123456789 + in lambda sA_0123456789 sA_0123456789 + sLiftMaybe sF (SJust sX) + = let + lambda :: + forall f x. + (t ~ f, t ~ Apply JustSym0 x) => + Sing f + -> Sing x -> Sing (Apply (Apply LiftMaybeSym0 t) t :: Maybe b) + lambda f x + = applySing + (singFun1 (Proxy :: Proxy JustSym0) SJust) (applySing f x) + in lambda sF sX + sLiftMaybe _s_z_0123456789 SNothing + = let + lambda :: + forall _z_0123456789. + (t ~ _z_0123456789, t ~ NothingSym0) => + Sing _z_0123456789 + -> Sing (Apply (Apply LiftMaybeSym0 t) t :: Maybe b) + lambda _z_0123456789 = SNothing + in lambda _s_z_0123456789 + sMap _s_z_0123456789 SNil + = let + lambda :: + forall _z_0123456789. + (t ~ _z_0123456789, t ~ '[]) => + Sing _z_0123456789 -> Sing (Apply (Apply MapSym0 t) t :: [b]) + lambda _z_0123456789 = SNil + in lambda _s_z_0123456789 + sMap sF (SCons sH sT) + = let + lambda :: + forall f h t. + (t ~ f, t ~ Apply (Apply (:$) h) t) => + Sing f + -> Sing h -> Sing t -> Sing (Apply (Apply MapSym0 t) t :: [b]) + lambda f h t + = applySing + (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) (applySing f h)) + (applySing + (applySing (singFun2 (Proxy :: Proxy MapSym0) sMap) f) t) + in lambda sF sH sT + data instance Sing (z :: Either a b) + = forall (n :: a). z ~ Left n => SLeft (Sing (n :: a)) | + forall (n :: b). z ~ Right n => SRight (Sing (n :: b)) + type SEither = (Sing :: Either a b -> GHC.Types.Type) + instance (SingKind (KProxy :: KProxy a), + SingKind (KProxy :: KProxy b)) => + SingKind (KProxy :: KProxy (Either a b)) where + type DemoteRep (KProxy :: KProxy (Either a b)) = Either (DemoteRep (KProxy :: KProxy a)) (DemoteRep (KProxy :: KProxy b)) + fromSing (SLeft b) = Left (fromSing b) + fromSing (SRight b) = Right (fromSing b) + toSing (Left b) + = case toSing b :: SomeSing (KProxy :: KProxy a) of { + SomeSing c -> SomeSing (SLeft c) } + toSing (Right b) + = case toSing b :: SomeSing (KProxy :: KProxy b) of { + SomeSing c -> SomeSing (SRight c) } + instance SingI n => SingI (Left (n :: a)) where + sing = SLeft sing + instance SingI n => SingI (Right (n :: b)) where + sing = SRight sing diff --git a/tests/compile-and-dump/Singletons/LambdaCase.ghc710.template b/tests/compile-and-dump/Singletons/LambdaCase.ghc710.template --- a/tests/compile-and-dump/Singletons/LambdaCase.ghc710.template +++ b/tests/compile-and-dump/Singletons/LambdaCase.ghc710.template @@ -118,48 +118,56 @@ = forall arg. KindOf (Apply Lambda_0123456789Sym0 arg) ~ KindOf (Lambda_0123456789Sym1 arg) => Lambda_0123456789Sym0KindInference type instance Apply Lambda_0123456789Sym0 l = Lambda_0123456789Sym1 l - type Foo3Sym2 (t :: a) (t :: b) = Foo3 t t + type Foo3Sym2 (t :: a0123456789) (t :: b0123456789) = Foo3 t t instance SuppressUnusedWarnings Foo3Sym1 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) Foo3Sym1KindInference GHC.Tuple.()) - data Foo3Sym1 (l :: a) (l :: TyFun b a) + data Foo3Sym1 (l :: a0123456789) + (l :: TyFun b0123456789 a0123456789) = forall arg. KindOf (Apply (Foo3Sym1 l) arg) ~ KindOf (Foo3Sym2 l arg) => Foo3Sym1KindInference type instance Apply (Foo3Sym1 l) l = Foo3Sym2 l l instance SuppressUnusedWarnings Foo3Sym0 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) Foo3Sym0KindInference GHC.Tuple.()) - data Foo3Sym0 (l :: TyFun a (TyFun b a -> *)) + data Foo3Sym0 (l :: TyFun a0123456789 (TyFun b0123456789 a0123456789 + -> *)) = forall arg. KindOf (Apply Foo3Sym0 arg) ~ KindOf (Foo3Sym1 arg) => Foo3Sym0KindInference type instance Apply Foo3Sym0 l = Foo3Sym1 l - type Foo2Sym2 (t :: a) (t :: Maybe a) = Foo2 t t + type Foo2Sym2 (t :: a0123456789) (t :: Maybe a0123456789) = + Foo2 t t instance SuppressUnusedWarnings Foo2Sym1 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) Foo2Sym1KindInference GHC.Tuple.()) - data Foo2Sym1 (l :: a) (l :: TyFun (Maybe a) a) + data Foo2Sym1 (l :: a0123456789) + (l :: TyFun (Maybe a0123456789) a0123456789) = forall arg. KindOf (Apply (Foo2Sym1 l) arg) ~ KindOf (Foo2Sym2 l arg) => Foo2Sym1KindInference type instance Apply (Foo2Sym1 l) l = Foo2Sym2 l l instance SuppressUnusedWarnings Foo2Sym0 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) Foo2Sym0KindInference GHC.Tuple.()) - data Foo2Sym0 (l :: TyFun a (TyFun (Maybe a) a -> *)) + data Foo2Sym0 (l :: TyFun a0123456789 (TyFun (Maybe a0123456789) a0123456789 + -> *)) = forall arg. KindOf (Apply Foo2Sym0 arg) ~ KindOf (Foo2Sym1 arg) => Foo2Sym0KindInference type instance Apply Foo2Sym0 l = Foo2Sym1 l - type Foo1Sym2 (t :: a) (t :: Maybe a) = Foo1 t t + type Foo1Sym2 (t :: a0123456789) (t :: Maybe a0123456789) = + Foo1 t t instance SuppressUnusedWarnings Foo1Sym1 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) Foo1Sym1KindInference GHC.Tuple.()) - data Foo1Sym1 (l :: a) (l :: TyFun (Maybe a) a) + data Foo1Sym1 (l :: a0123456789) + (l :: TyFun (Maybe a0123456789) a0123456789) = forall arg. KindOf (Apply (Foo1Sym1 l) arg) ~ KindOf (Foo1Sym2 l arg) => Foo1Sym1KindInference type instance Apply (Foo1Sym1 l) l = Foo1Sym2 l l instance SuppressUnusedWarnings Foo1Sym0 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) Foo1Sym0KindInference GHC.Tuple.()) - data Foo1Sym0 (l :: TyFun a (TyFun (Maybe a) a -> *)) + data Foo1Sym0 (l :: TyFun a0123456789 (TyFun (Maybe a0123456789) a0123456789 + -> *)) = forall arg. KindOf (Apply Foo1Sym0 arg) ~ KindOf (Foo1Sym1 arg) => Foo1Sym0KindInference type instance Apply Foo1Sym0 l = Foo1Sym1 l @@ -182,7 +190,7 @@ = let lambda :: forall a b. (t ~ a, t ~ b) => - Sing a -> Sing b -> Sing (Apply (Apply Foo3Sym0 a) b :: a) + Sing a -> Sing b -> Sing (Apply (Apply Foo3Sym0 t) t :: a) lambda a b = applySing (singFun1 @@ -215,8 +223,7 @@ lambda :: forall d _z_0123456789. (t ~ d, t ~ _z_0123456789) => Sing d - -> Sing _z_0123456789 - -> Sing (Apply (Apply Foo2Sym0 d) _z_0123456789 :: a) + -> Sing _z_0123456789 -> Sing (Apply (Apply Foo2Sym0 t) t :: a) lambda d _z_0123456789 = applySing (singFun1 @@ -253,7 +260,7 @@ = let lambda :: forall d x. (t ~ d, t ~ x) => - Sing d -> Sing x -> Sing (Apply (Apply Foo1Sym0 d) x :: a) + Sing d -> Sing x -> Sing (Apply (Apply Foo1Sym0 t) t :: a) lambda d x = applySing (singFun1 diff --git a/tests/compile-and-dump/Singletons/LambdaCase.ghc80.template b/tests/compile-and-dump/Singletons/LambdaCase.ghc80.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/LambdaCase.ghc80.template @@ -0,0 +1,299 @@ +Singletons/LambdaCase.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| foo1 :: a -> Maybe a -> a + foo1 d x + = (\case { + Just y -> y + Nothing -> d }) + x + foo2 :: a -> Maybe a -> a + foo2 d _ + = (\case { + Just y -> y + Nothing -> d }) + (Just d) + foo3 :: a -> b -> a + foo3 a b = (\case { (p, _) -> p }) (a, b) |] + ======> + foo1 :: forall a. a -> Maybe a -> a + foo1 d x + = \case { + Just y -> y + Nothing -> d } + x + foo2 :: forall a. a -> Maybe a -> a + foo2 d _ + = \case { + Just y -> y + Nothing -> d } + (Just d) + foo3 :: forall a b. a -> b -> a + foo3 a b = \case { (p, _) -> p } (a, b) + type family Case_0123456789 a b x_0123456789 t where + Case_0123456789 a b x_0123456789 '(p, _z_0123456789) = p + type family Lambda_0123456789 a b t where + Lambda_0123456789 a b x_0123456789 = Case_0123456789 a b x_0123456789 x_0123456789 + type Lambda_0123456789Sym3 t t t = Lambda_0123456789 t t t + instance SuppressUnusedWarnings Lambda_0123456789Sym2 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym2KindInference GHC.Tuple.()) + data Lambda_0123456789Sym2 l l l + = forall arg. KindOf (Apply (Lambda_0123456789Sym2 l l) arg) ~ KindOf (Lambda_0123456789Sym3 l l arg) => + Lambda_0123456789Sym2KindInference + type instance Apply (Lambda_0123456789Sym2 l l) l = Lambda_0123456789Sym3 l l l + instance SuppressUnusedWarnings Lambda_0123456789Sym1 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym1KindInference GHC.Tuple.()) + data Lambda_0123456789Sym1 l l + = forall arg. KindOf (Apply (Lambda_0123456789Sym1 l) arg) ~ KindOf (Lambda_0123456789Sym2 l arg) => + Lambda_0123456789Sym1KindInference + type instance Apply (Lambda_0123456789Sym1 l) l = Lambda_0123456789Sym2 l l + instance SuppressUnusedWarnings Lambda_0123456789Sym0 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym0KindInference GHC.Tuple.()) + data Lambda_0123456789Sym0 l + = forall arg. KindOf (Apply Lambda_0123456789Sym0 arg) ~ KindOf (Lambda_0123456789Sym1 arg) => + Lambda_0123456789Sym0KindInference + type instance Apply Lambda_0123456789Sym0 l = Lambda_0123456789Sym1 l + type family Case_0123456789 d x_0123456789 _z_0123456789 t where + Case_0123456789 d x_0123456789 _z_0123456789 (Just y) = y + Case_0123456789 d x_0123456789 _z_0123456789 Nothing = d + type family Lambda_0123456789 d _z_0123456789 t where + Lambda_0123456789 d _z_0123456789 x_0123456789 = Case_0123456789 d x_0123456789 _z_0123456789 x_0123456789 + type Lambda_0123456789Sym3 t t t = Lambda_0123456789 t t t + instance SuppressUnusedWarnings Lambda_0123456789Sym2 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym2KindInference GHC.Tuple.()) + data Lambda_0123456789Sym2 l l l + = forall arg. KindOf (Apply (Lambda_0123456789Sym2 l l) arg) ~ KindOf (Lambda_0123456789Sym3 l l arg) => + Lambda_0123456789Sym2KindInference + type instance Apply (Lambda_0123456789Sym2 l l) l = Lambda_0123456789Sym3 l l l + instance SuppressUnusedWarnings Lambda_0123456789Sym1 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym1KindInference GHC.Tuple.()) + data Lambda_0123456789Sym1 l l + = forall arg. KindOf (Apply (Lambda_0123456789Sym1 l) arg) ~ KindOf (Lambda_0123456789Sym2 l arg) => + Lambda_0123456789Sym1KindInference + type instance Apply (Lambda_0123456789Sym1 l) l = Lambda_0123456789Sym2 l l + instance SuppressUnusedWarnings Lambda_0123456789Sym0 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym0KindInference GHC.Tuple.()) + data Lambda_0123456789Sym0 l + = forall arg. KindOf (Apply Lambda_0123456789Sym0 arg) ~ KindOf (Lambda_0123456789Sym1 arg) => + Lambda_0123456789Sym0KindInference + type instance Apply Lambda_0123456789Sym0 l = Lambda_0123456789Sym1 l + type family Case_0123456789 d x x_0123456789 t where + Case_0123456789 d x x_0123456789 (Just y) = y + Case_0123456789 d x x_0123456789 Nothing = d + type family Lambda_0123456789 d x t where + Lambda_0123456789 d x x_0123456789 = Case_0123456789 d x x_0123456789 x_0123456789 + type Lambda_0123456789Sym3 t t t = Lambda_0123456789 t t t + instance SuppressUnusedWarnings Lambda_0123456789Sym2 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym2KindInference GHC.Tuple.()) + data Lambda_0123456789Sym2 l l l + = forall arg. KindOf (Apply (Lambda_0123456789Sym2 l l) arg) ~ KindOf (Lambda_0123456789Sym3 l l arg) => + Lambda_0123456789Sym2KindInference + type instance Apply (Lambda_0123456789Sym2 l l) l = Lambda_0123456789Sym3 l l l + instance SuppressUnusedWarnings Lambda_0123456789Sym1 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym1KindInference GHC.Tuple.()) + data Lambda_0123456789Sym1 l l + = forall arg. KindOf (Apply (Lambda_0123456789Sym1 l) arg) ~ KindOf (Lambda_0123456789Sym2 l arg) => + Lambda_0123456789Sym1KindInference + type instance Apply (Lambda_0123456789Sym1 l) l = Lambda_0123456789Sym2 l l + instance SuppressUnusedWarnings Lambda_0123456789Sym0 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym0KindInference GHC.Tuple.()) + data Lambda_0123456789Sym0 l + = forall arg. KindOf (Apply Lambda_0123456789Sym0 arg) ~ KindOf (Lambda_0123456789Sym1 arg) => + Lambda_0123456789Sym0KindInference + type instance Apply Lambda_0123456789Sym0 l = Lambda_0123456789Sym1 l + type Foo3Sym2 (t :: a0123456789) (t :: b0123456789) = Foo3 t t + instance SuppressUnusedWarnings Foo3Sym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Foo3Sym1KindInference GHC.Tuple.()) + data Foo3Sym1 (l :: a0123456789) + (l :: TyFun b0123456789 a0123456789) + = forall arg. KindOf (Apply (Foo3Sym1 l) arg) ~ KindOf (Foo3Sym2 l arg) => + Foo3Sym1KindInference + type instance Apply (Foo3Sym1 l) l = Foo3Sym2 l l + instance SuppressUnusedWarnings Foo3Sym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Foo3Sym0KindInference GHC.Tuple.()) + data Foo3Sym0 (l :: TyFun a0123456789 (TyFun b0123456789 a0123456789 + -> GHC.Types.Type)) + = forall arg. KindOf (Apply Foo3Sym0 arg) ~ KindOf (Foo3Sym1 arg) => + Foo3Sym0KindInference + type instance Apply Foo3Sym0 l = Foo3Sym1 l + type Foo2Sym2 (t :: a0123456789) (t :: Maybe a0123456789) = + Foo2 t t + instance SuppressUnusedWarnings Foo2Sym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Foo2Sym1KindInference GHC.Tuple.()) + data Foo2Sym1 (l :: a0123456789) + (l :: TyFun (Maybe a0123456789) a0123456789) + = forall arg. KindOf (Apply (Foo2Sym1 l) arg) ~ KindOf (Foo2Sym2 l arg) => + Foo2Sym1KindInference + type instance Apply (Foo2Sym1 l) l = Foo2Sym2 l l + instance SuppressUnusedWarnings Foo2Sym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Foo2Sym0KindInference GHC.Tuple.()) + data Foo2Sym0 (l :: TyFun a0123456789 (TyFun (Maybe a0123456789) a0123456789 + -> GHC.Types.Type)) + = forall arg. KindOf (Apply Foo2Sym0 arg) ~ KindOf (Foo2Sym1 arg) => + Foo2Sym0KindInference + type instance Apply Foo2Sym0 l = Foo2Sym1 l + type Foo1Sym2 (t :: a0123456789) (t :: Maybe a0123456789) = + Foo1 t t + instance SuppressUnusedWarnings Foo1Sym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Foo1Sym1KindInference GHC.Tuple.()) + data Foo1Sym1 (l :: a0123456789) + (l :: TyFun (Maybe a0123456789) a0123456789) + = forall arg. KindOf (Apply (Foo1Sym1 l) arg) ~ KindOf (Foo1Sym2 l arg) => + Foo1Sym1KindInference + type instance Apply (Foo1Sym1 l) l = Foo1Sym2 l l + instance SuppressUnusedWarnings Foo1Sym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Foo1Sym0KindInference GHC.Tuple.()) + data Foo1Sym0 (l :: TyFun a0123456789 (TyFun (Maybe a0123456789) a0123456789 + -> GHC.Types.Type)) + = forall arg. KindOf (Apply Foo1Sym0 arg) ~ KindOf (Foo1Sym1 arg) => + Foo1Sym0KindInference + type instance Apply Foo1Sym0 l = Foo1Sym1 l + type family Foo3 (a :: a) (a :: b) :: a where + Foo3 a b = Apply (Apply (Apply Lambda_0123456789Sym0 a) b) (Apply (Apply Tuple2Sym0 a) b) + type family Foo2 (a :: a) (a :: Maybe a) :: a where + Foo2 d _z_0123456789 = Apply (Apply (Apply Lambda_0123456789Sym0 d) _z_0123456789) (Apply JustSym0 d) + type family Foo1 (a :: a) (a :: Maybe a) :: a where + Foo1 d x = Apply (Apply (Apply Lambda_0123456789Sym0 d) x) x + sFoo3 :: + forall (t :: a) (t :: b). + Sing t -> Sing t -> Sing (Apply (Apply Foo3Sym0 t) t :: a) + sFoo2 :: + forall (t :: a) (t :: Maybe a). + Sing t -> Sing t -> Sing (Apply (Apply Foo2Sym0 t) t :: a) + sFoo1 :: + forall (t :: a) (t :: Maybe a). + Sing t -> Sing t -> Sing (Apply (Apply Foo1Sym0 t) t :: a) + sFoo3 sA sB + = let + lambda :: + forall a b. + (t ~ a, t ~ b) => + Sing a -> Sing b -> Sing (Apply (Apply Foo3Sym0 t) t :: a) + lambda a b + = applySing + (singFun1 + (Proxy :: Proxy (Apply (Apply Lambda_0123456789Sym0 a) b)) + (\ sX_0123456789 + -> let + lambda :: + forall x_0123456789. + Sing x_0123456789 + -> Sing (Apply (Apply (Apply Lambda_0123456789Sym0 a) b) x_0123456789) + lambda x_0123456789 + = case x_0123456789 of { + STuple2 sP _s_z_0123456789 + -> let + lambda :: + forall p _z_0123456789. + Apply (Apply Tuple2Sym0 p) _z_0123456789 ~ x_0123456789 => + Sing p + -> Sing _z_0123456789 + -> Sing (Case_0123456789 a b x_0123456789 (Apply (Apply Tuple2Sym0 p) _z_0123456789)) + lambda p _z_0123456789 = p + in lambda sP _s_z_0123456789 } :: + Sing (Case_0123456789 a b x_0123456789 x_0123456789) + in lambda sX_0123456789)) + (applySing + (applySing (singFun2 (Proxy :: Proxy Tuple2Sym0) STuple2) a) b) + in lambda sA sB + sFoo2 sD _s_z_0123456789 + = let + lambda :: + forall d _z_0123456789. + (t ~ d, t ~ _z_0123456789) => + Sing d + -> Sing _z_0123456789 -> Sing (Apply (Apply Foo2Sym0 t) t :: a) + lambda d _z_0123456789 + = applySing + (singFun1 + (Proxy :: + Proxy (Apply (Apply Lambda_0123456789Sym0 d) _z_0123456789)) + (\ sX_0123456789 + -> let + lambda :: + forall x_0123456789. + Sing x_0123456789 + -> Sing (Apply (Apply (Apply Lambda_0123456789Sym0 d) _z_0123456789) x_0123456789) + lambda x_0123456789 + = case x_0123456789 of { + SJust sY + -> let + lambda :: + forall y. + Apply JustSym0 y ~ x_0123456789 => + Sing y + -> Sing (Case_0123456789 d x_0123456789 _z_0123456789 (Apply JustSym0 y)) + lambda y = y + in lambda sY + SNothing + -> let + lambda :: + NothingSym0 ~ x_0123456789 => + Sing (Case_0123456789 d x_0123456789 _z_0123456789 NothingSym0) + lambda = d + in lambda } :: + Sing (Case_0123456789 d x_0123456789 _z_0123456789 x_0123456789) + in lambda sX_0123456789)) + (applySing (singFun1 (Proxy :: Proxy JustSym0) SJust) d) + in lambda sD _s_z_0123456789 + sFoo1 sD sX + = let + lambda :: + forall d x. + (t ~ d, t ~ x) => + Sing d -> Sing x -> Sing (Apply (Apply Foo1Sym0 t) t :: a) + lambda d x + = applySing + (singFun1 + (Proxy :: Proxy (Apply (Apply Lambda_0123456789Sym0 d) x)) + (\ sX_0123456789 + -> let + lambda :: + forall x_0123456789. + Sing x_0123456789 + -> Sing (Apply (Apply (Apply Lambda_0123456789Sym0 d) x) x_0123456789) + lambda x_0123456789 + = case x_0123456789 of { + SJust sY + -> let + lambda :: + forall y. + Apply JustSym0 y ~ x_0123456789 => + Sing y + -> Sing (Case_0123456789 d x x_0123456789 (Apply JustSym0 y)) + lambda y = y + in lambda sY + SNothing + -> let + lambda :: + NothingSym0 ~ x_0123456789 => + Sing (Case_0123456789 d x x_0123456789 NothingSym0) + lambda = d + in lambda } :: + Sing (Case_0123456789 d x x_0123456789 x_0123456789) + in lambda sX_0123456789)) + x + in lambda sD sX diff --git a/tests/compile-and-dump/Singletons/Lambdas.ghc710.template b/tests/compile-and-dump/Singletons/Lambdas.ghc710.template --- a/tests/compile-and-dump/Singletons/Lambdas.ghc710.template +++ b/tests/compile-and-dump/Singletons/Lambdas.ghc710.template @@ -40,18 +40,20 @@ data Foo a b = Foo a b foo8 :: forall a b. Foo a b -> a foo8 x = \ (Foo a _) -> a x - type FooSym2 (t :: a) (t :: b) = Foo t t + type FooSym2 (t :: a0123456789) (t :: b0123456789) = Foo t t instance SuppressUnusedWarnings FooSym1 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) FooSym1KindInference GHC.Tuple.()) - data FooSym1 (l :: a) (l :: TyFun b (Foo a b)) + data FooSym1 (l :: a0123456789) + (l :: TyFun b0123456789 (Foo a0123456789 b0123456789)) = forall arg. KindOf (Apply (FooSym1 l) arg) ~ KindOf (FooSym2 l arg) => FooSym1KindInference type instance Apply (FooSym1 l) l = FooSym2 l l instance SuppressUnusedWarnings FooSym0 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) FooSym0KindInference GHC.Tuple.()) - data FooSym0 (l :: TyFun a (TyFun b (Foo a b) -> *)) + data FooSym0 (l :: TyFun a0123456789 (TyFun b0123456789 (Foo a0123456789 b0123456789) + -> *)) = forall arg. KindOf (Apply FooSym0 arg) ~ KindOf (FooSym1 arg) => FooSym0KindInference type instance Apply FooSym0 l = FooSym1 l @@ -359,131 +361,151 @@ = forall arg. KindOf (Apply Lambda_0123456789Sym0 arg) ~ KindOf (Lambda_0123456789Sym1 arg) => Lambda_0123456789Sym0KindInference type instance Apply Lambda_0123456789Sym0 l = Lambda_0123456789Sym1 l - type Foo8Sym1 (t :: Foo a b) = Foo8 t + type Foo8Sym1 (t :: Foo a0123456789 b0123456789) = Foo8 t instance SuppressUnusedWarnings Foo8Sym0 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) Foo8Sym0KindInference GHC.Tuple.()) - data Foo8Sym0 (l :: TyFun (Foo a b) a) + data Foo8Sym0 (l :: TyFun (Foo a0123456789 b0123456789) a0123456789) = forall arg. KindOf (Apply Foo8Sym0 arg) ~ KindOf (Foo8Sym1 arg) => Foo8Sym0KindInference type instance Apply Foo8Sym0 l = Foo8Sym1 l - type Foo7Sym2 (t :: a) (t :: b) = Foo7 t t + type Foo7Sym2 (t :: a0123456789) (t :: b0123456789) = Foo7 t t instance SuppressUnusedWarnings Foo7Sym1 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) Foo7Sym1KindInference GHC.Tuple.()) - data Foo7Sym1 (l :: a) (l :: TyFun b b) + data Foo7Sym1 (l :: a0123456789) + (l :: TyFun b0123456789 b0123456789) = forall arg. KindOf (Apply (Foo7Sym1 l) arg) ~ KindOf (Foo7Sym2 l arg) => Foo7Sym1KindInference type instance Apply (Foo7Sym1 l) l = Foo7Sym2 l l instance SuppressUnusedWarnings Foo7Sym0 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) Foo7Sym0KindInference GHC.Tuple.()) - data Foo7Sym0 (l :: TyFun a (TyFun b b -> *)) + data Foo7Sym0 (l :: TyFun a0123456789 (TyFun b0123456789 b0123456789 + -> *)) = forall arg. KindOf (Apply Foo7Sym0 arg) ~ KindOf (Foo7Sym1 arg) => Foo7Sym0KindInference type instance Apply Foo7Sym0 l = Foo7Sym1 l - type Foo6Sym2 (t :: a) (t :: b) = Foo6 t t + type Foo6Sym2 (t :: a0123456789) (t :: b0123456789) = Foo6 t t instance SuppressUnusedWarnings Foo6Sym1 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) Foo6Sym1KindInference GHC.Tuple.()) - data Foo6Sym1 (l :: a) (l :: TyFun b a) + data Foo6Sym1 (l :: a0123456789) + (l :: TyFun b0123456789 a0123456789) = forall arg. KindOf (Apply (Foo6Sym1 l) arg) ~ KindOf (Foo6Sym2 l arg) => Foo6Sym1KindInference type instance Apply (Foo6Sym1 l) l = Foo6Sym2 l l instance SuppressUnusedWarnings Foo6Sym0 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) Foo6Sym0KindInference GHC.Tuple.()) - data Foo6Sym0 (l :: TyFun a (TyFun b a -> *)) + data Foo6Sym0 (l :: TyFun a0123456789 (TyFun b0123456789 a0123456789 + -> *)) = forall arg. KindOf (Apply Foo6Sym0 arg) ~ KindOf (Foo6Sym1 arg) => Foo6Sym0KindInference type instance Apply Foo6Sym0 l = Foo6Sym1 l - type Foo5Sym2 (t :: a) (t :: b) = Foo5 t t + type Foo5Sym2 (t :: a0123456789) (t :: b0123456789) = Foo5 t t instance SuppressUnusedWarnings Foo5Sym1 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) Foo5Sym1KindInference GHC.Tuple.()) - data Foo5Sym1 (l :: a) (l :: TyFun b b) + data Foo5Sym1 (l :: a0123456789) + (l :: TyFun b0123456789 b0123456789) = forall arg. KindOf (Apply (Foo5Sym1 l) arg) ~ KindOf (Foo5Sym2 l arg) => Foo5Sym1KindInference type instance Apply (Foo5Sym1 l) l = Foo5Sym2 l l instance SuppressUnusedWarnings Foo5Sym0 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) Foo5Sym0KindInference GHC.Tuple.()) - data Foo5Sym0 (l :: TyFun a (TyFun b b -> *)) + data Foo5Sym0 (l :: TyFun a0123456789 (TyFun b0123456789 b0123456789 + -> *)) = forall arg. KindOf (Apply Foo5Sym0 arg) ~ KindOf (Foo5Sym1 arg) => Foo5Sym0KindInference type instance Apply Foo5Sym0 l = Foo5Sym1 l - type Foo4Sym3 (t :: a) (t :: b) (t :: c) = Foo4 t t t + type Foo4Sym3 (t :: a0123456789) + (t :: b0123456789) + (t :: c0123456789) = + Foo4 t t t instance SuppressUnusedWarnings Foo4Sym2 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) Foo4Sym2KindInference GHC.Tuple.()) - data Foo4Sym2 (l :: a) (l :: b) (l :: TyFun c a) + data Foo4Sym2 (l :: a0123456789) + (l :: b0123456789) + (l :: TyFun c0123456789 a0123456789) = forall arg. KindOf (Apply (Foo4Sym2 l l) arg) ~ KindOf (Foo4Sym3 l l arg) => Foo4Sym2KindInference type instance Apply (Foo4Sym2 l l) l = Foo4Sym3 l l l instance SuppressUnusedWarnings Foo4Sym1 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) Foo4Sym1KindInference GHC.Tuple.()) - data Foo4Sym1 (l :: a) (l :: TyFun b (TyFun c a -> *)) + data Foo4Sym1 (l :: a0123456789) + (l :: TyFun b0123456789 (TyFun c0123456789 a0123456789 -> *)) = forall arg. KindOf (Apply (Foo4Sym1 l) arg) ~ KindOf (Foo4Sym2 l arg) => Foo4Sym1KindInference type instance Apply (Foo4Sym1 l) l = Foo4Sym2 l l instance SuppressUnusedWarnings Foo4Sym0 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) Foo4Sym0KindInference GHC.Tuple.()) - data Foo4Sym0 (l :: TyFun a (TyFun b (TyFun c a -> *) -> *)) + data Foo4Sym0 (l :: TyFun a0123456789 (TyFun b0123456789 (TyFun c0123456789 a0123456789 + -> *) + -> *)) = forall arg. KindOf (Apply Foo4Sym0 arg) ~ KindOf (Foo4Sym1 arg) => Foo4Sym0KindInference type instance Apply Foo4Sym0 l = Foo4Sym1 l - type Foo3Sym1 (t :: a) = Foo3 t + type Foo3Sym1 (t :: a0123456789) = Foo3 t instance SuppressUnusedWarnings Foo3Sym0 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) Foo3Sym0KindInference GHC.Tuple.()) - data Foo3Sym0 (l :: TyFun a a) + data Foo3Sym0 (l :: TyFun a0123456789 a0123456789) = forall arg. KindOf (Apply Foo3Sym0 arg) ~ KindOf (Foo3Sym1 arg) => Foo3Sym0KindInference type instance Apply Foo3Sym0 l = Foo3Sym1 l - type Foo2Sym2 (t :: a) (t :: b) = Foo2 t t + type Foo2Sym2 (t :: a0123456789) (t :: b0123456789) = Foo2 t t instance SuppressUnusedWarnings Foo2Sym1 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) Foo2Sym1KindInference GHC.Tuple.()) - data Foo2Sym1 (l :: a) (l :: TyFun b a) + data Foo2Sym1 (l :: a0123456789) + (l :: TyFun b0123456789 a0123456789) = forall arg. KindOf (Apply (Foo2Sym1 l) arg) ~ KindOf (Foo2Sym2 l arg) => Foo2Sym1KindInference type instance Apply (Foo2Sym1 l) l = Foo2Sym2 l l instance SuppressUnusedWarnings Foo2Sym0 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) Foo2Sym0KindInference GHC.Tuple.()) - data Foo2Sym0 (l :: TyFun a (TyFun b a -> *)) + data Foo2Sym0 (l :: TyFun a0123456789 (TyFun b0123456789 a0123456789 + -> *)) = forall arg. KindOf (Apply Foo2Sym0 arg) ~ KindOf (Foo2Sym1 arg) => Foo2Sym0KindInference type instance Apply Foo2Sym0 l = Foo2Sym1 l - type Foo1Sym2 (t :: a) (t :: b) = Foo1 t t + type Foo1Sym2 (t :: a0123456789) (t :: b0123456789) = Foo1 t t instance SuppressUnusedWarnings Foo1Sym1 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) Foo1Sym1KindInference GHC.Tuple.()) - data Foo1Sym1 (l :: a) (l :: TyFun b a) + data Foo1Sym1 (l :: a0123456789) + (l :: TyFun b0123456789 a0123456789) = forall arg. KindOf (Apply (Foo1Sym1 l) arg) ~ KindOf (Foo1Sym2 l arg) => Foo1Sym1KindInference type instance Apply (Foo1Sym1 l) l = Foo1Sym2 l l instance SuppressUnusedWarnings Foo1Sym0 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) Foo1Sym0KindInference GHC.Tuple.()) - data Foo1Sym0 (l :: TyFun a (TyFun b a -> *)) + data Foo1Sym0 (l :: TyFun a0123456789 (TyFun b0123456789 a0123456789 + -> *)) = forall arg. KindOf (Apply Foo1Sym0 arg) ~ KindOf (Foo1Sym1 arg) => Foo1Sym0KindInference type instance Apply Foo1Sym0 l = Foo1Sym1 l - type Foo0Sym2 (t :: a) (t :: b) = Foo0 t t + type Foo0Sym2 (t :: a0123456789) (t :: b0123456789) = Foo0 t t instance SuppressUnusedWarnings Foo0Sym1 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) Foo0Sym1KindInference GHC.Tuple.()) - data Foo0Sym1 (l :: a) (l :: TyFun b a) + data Foo0Sym1 (l :: a0123456789) + (l :: TyFun b0123456789 a0123456789) = forall arg. KindOf (Apply (Foo0Sym1 l) arg) ~ KindOf (Foo0Sym2 l arg) => Foo0Sym1KindInference type instance Apply (Foo0Sym1 l) l = Foo0Sym2 l l instance SuppressUnusedWarnings Foo0Sym0 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) Foo0Sym0KindInference GHC.Tuple.()) - data Foo0Sym0 (l :: TyFun a (TyFun b a -> *)) + data Foo0Sym0 (l :: TyFun a0123456789 (TyFun b0123456789 a0123456789 + -> *)) = forall arg. KindOf (Apply Foo0Sym0 arg) ~ KindOf (Foo0Sym1 arg) => Foo0Sym0KindInference type instance Apply Foo0Sym0 l = Foo0Sym1 l @@ -533,7 +555,7 @@ Sing t -> Sing t -> Sing (Apply (Apply Foo0Sym0 t) t :: a) sFoo8 sX = let - lambda :: forall x. t ~ x => Sing x -> Sing (Apply Foo8Sym0 x :: a) + lambda :: forall x. t ~ x => Sing x -> Sing (Apply Foo8Sym0 t :: a) lambda x = applySing (singFun1 @@ -564,7 +586,7 @@ = let lambda :: forall x y. (t ~ x, t ~ y) => - Sing x -> Sing y -> Sing (Apply (Apply Foo7Sym0 x) y :: b) + Sing x -> Sing y -> Sing (Apply (Apply Foo7Sym0 t) t :: b) lambda x y = applySing (singFun1 @@ -596,7 +618,7 @@ = let lambda :: forall a b. (t ~ a, t ~ b) => - Sing a -> Sing b -> Sing (Apply (Apply Foo6Sym0 a) b :: a) + Sing a -> Sing b -> Sing (Apply (Apply Foo6Sym0 t) t :: a) lambda a b = applySing (applySing @@ -637,7 +659,7 @@ = let lambda :: forall x y. (t ~ x, t ~ y) => - Sing x -> Sing y -> Sing (Apply (Apply Foo5Sym0 x) y :: b) + Sing x -> Sing y -> Sing (Apply (Apply Foo5Sym0 t) t :: b) lambda x y = applySing (singFun1 @@ -657,7 +679,7 @@ forall x y z. (t ~ x, t ~ y, t ~ z) => Sing x -> Sing y - -> Sing z -> Sing (Apply (Apply (Apply Foo4Sym0 x) y) z :: a) + -> Sing z -> Sing (Apply (Apply (Apply Foo4Sym0 t) t) t :: a) lambda x y z = applySing (applySing @@ -696,7 +718,7 @@ in lambda sX sY sZ sFoo3 sX = let - lambda :: forall x. t ~ x => Sing x -> Sing (Apply Foo3Sym0 x :: a) + lambda :: forall x. t ~ x => Sing x -> Sing (Apply Foo3Sym0 t :: a) lambda x = applySing (singFun1 @@ -713,7 +735,7 @@ = let lambda :: forall x y. (t ~ x, t ~ y) => - Sing x -> Sing y -> Sing (Apply (Apply Foo2Sym0 x) y :: a) + Sing x -> Sing y -> Sing (Apply (Apply Foo2Sym0 t) t :: a) lambda x y = applySing (singFun1 @@ -743,8 +765,7 @@ lambda :: forall x a_0123456789. (t ~ x, t ~ a_0123456789) => Sing x - -> Sing a_0123456789 - -> Sing (Apply (Apply Foo1Sym0 x) a_0123456789 :: a) + -> Sing a_0123456789 -> Sing (Apply (Apply Foo1Sym0 t) t :: a) lambda x a_0123456789 = applySing (singFun1 @@ -776,8 +797,7 @@ forall a_0123456789 a_0123456789. (t ~ a_0123456789, t ~ a_0123456789) => Sing a_0123456789 - -> Sing a_0123456789 - -> Sing (Apply (Apply Foo0Sym0 a_0123456789) a_0123456789 :: a) + -> Sing a_0123456789 -> Sing (Apply (Apply Foo0Sym0 t) t :: a) lambda a_0123456789 a_0123456789 = applySing (applySing diff --git a/tests/compile-and-dump/Singletons/Lambdas.ghc80.template b/tests/compile-and-dump/Singletons/Lambdas.ghc80.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/Lambdas.ghc80.template @@ -0,0 +1,846 @@ +Singletons/Lambdas.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| foo0 :: a -> b -> a + foo0 = (\ x y -> x) + foo1 :: a -> b -> a + foo1 x = (\ _ -> x) + foo2 :: a -> b -> a + foo2 x y = (\ _ -> x) y + foo3 :: a -> a + foo3 x = (\ y -> y) x + foo4 :: a -> b -> c -> a + foo4 x y z = (\ _ _ -> x) y z + foo5 :: a -> b -> b + foo5 x y = (\ x -> x) y + foo6 :: a -> b -> a + foo6 a b = (\ x -> \ _ -> x) a b + foo7 :: a -> b -> b + foo7 x y = (\ (_, b) -> b) (x, y) + foo8 :: Foo a b -> a + foo8 x = (\ (Foo a _) -> a) x + + data Foo a b = Foo a b |] + ======> + foo0 :: forall a b. a -> b -> a + foo0 = \ x y -> x + foo1 :: forall a b. a -> b -> a + foo1 x = \ _ -> x + foo2 :: forall a b. a -> b -> a + foo2 x y = (\ _ -> x) y + foo3 :: forall a. a -> a + foo3 x = (\ y -> y) x + foo4 :: forall a b c. a -> b -> c -> a + foo4 x y z = (\ _ _ -> x) y z + foo5 :: forall a b. a -> b -> b + foo5 x y = (\ x -> x) y + foo6 :: forall a b. a -> b -> a + foo6 a b = (\ x -> \ _ -> x) a b + foo7 :: forall a b. a -> b -> b + foo7 x y = (\ (_, b) -> b) (x, y) + data Foo a b = Foo a b + foo8 :: forall a b. Foo a b -> a + foo8 x = (\ (Foo a _) -> a) x + type FooSym2 (t :: a0123456789) (t :: b0123456789) = Foo t t + instance SuppressUnusedWarnings FooSym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) FooSym1KindInference GHC.Tuple.()) + data FooSym1 (l :: a0123456789) + (l :: TyFun b0123456789 (Foo a0123456789 b0123456789)) + = forall arg. KindOf (Apply (FooSym1 l) arg) ~ KindOf (FooSym2 l arg) => + FooSym1KindInference + type instance Apply (FooSym1 l) l = FooSym2 l l + instance SuppressUnusedWarnings FooSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) FooSym0KindInference GHC.Tuple.()) + data FooSym0 (l :: TyFun a0123456789 (TyFun b0123456789 (Foo a0123456789 b0123456789) + -> GHC.Types.Type)) + = forall arg. KindOf (Apply FooSym0 arg) ~ KindOf (FooSym1 arg) => + FooSym0KindInference + type instance Apply FooSym0 l = FooSym1 l + type family Case_0123456789 x arg_0123456789 t where + Case_0123456789 x arg_0123456789 (Foo a _z_0123456789) = a + type family Lambda_0123456789 x t where + Lambda_0123456789 x arg_0123456789 = Case_0123456789 x arg_0123456789 arg_0123456789 + type Lambda_0123456789Sym2 t t = Lambda_0123456789 t t + instance SuppressUnusedWarnings Lambda_0123456789Sym1 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym1KindInference GHC.Tuple.()) + data Lambda_0123456789Sym1 l l + = forall arg. KindOf (Apply (Lambda_0123456789Sym1 l) arg) ~ KindOf (Lambda_0123456789Sym2 l arg) => + Lambda_0123456789Sym1KindInference + type instance Apply (Lambda_0123456789Sym1 l) l = Lambda_0123456789Sym2 l l + instance SuppressUnusedWarnings Lambda_0123456789Sym0 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym0KindInference GHC.Tuple.()) + data Lambda_0123456789Sym0 l + = forall arg. KindOf (Apply Lambda_0123456789Sym0 arg) ~ KindOf (Lambda_0123456789Sym1 arg) => + Lambda_0123456789Sym0KindInference + type instance Apply Lambda_0123456789Sym0 l = Lambda_0123456789Sym1 l + type family Case_0123456789 x y arg_0123456789 t where + Case_0123456789 x y arg_0123456789 '(_z_0123456789, b) = b + type family Lambda_0123456789 x y t where + Lambda_0123456789 x y arg_0123456789 = Case_0123456789 x y arg_0123456789 arg_0123456789 + type Lambda_0123456789Sym3 t t t = Lambda_0123456789 t t t + instance SuppressUnusedWarnings Lambda_0123456789Sym2 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym2KindInference GHC.Tuple.()) + data Lambda_0123456789Sym2 l l l + = forall arg. KindOf (Apply (Lambda_0123456789Sym2 l l) arg) ~ KindOf (Lambda_0123456789Sym3 l l arg) => + Lambda_0123456789Sym2KindInference + type instance Apply (Lambda_0123456789Sym2 l l) l = Lambda_0123456789Sym3 l l l + instance SuppressUnusedWarnings Lambda_0123456789Sym1 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym1KindInference GHC.Tuple.()) + data Lambda_0123456789Sym1 l l + = forall arg. KindOf (Apply (Lambda_0123456789Sym1 l) arg) ~ KindOf (Lambda_0123456789Sym2 l arg) => + Lambda_0123456789Sym1KindInference + type instance Apply (Lambda_0123456789Sym1 l) l = Lambda_0123456789Sym2 l l + instance SuppressUnusedWarnings Lambda_0123456789Sym0 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym0KindInference GHC.Tuple.()) + data Lambda_0123456789Sym0 l + = forall arg. KindOf (Apply Lambda_0123456789Sym0 arg) ~ KindOf (Lambda_0123456789Sym1 arg) => + Lambda_0123456789Sym0KindInference + type instance Apply Lambda_0123456789Sym0 l = Lambda_0123456789Sym1 l + type family Case_0123456789 a b x arg_0123456789 t where + Case_0123456789 a b x arg_0123456789 _z_0123456789 = x + type family Lambda_0123456789 a b x t where + Lambda_0123456789 a b x arg_0123456789 = Case_0123456789 a b x arg_0123456789 arg_0123456789 + type Lambda_0123456789Sym4 t t t t = Lambda_0123456789 t t t t + instance SuppressUnusedWarnings Lambda_0123456789Sym3 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym3KindInference GHC.Tuple.()) + data Lambda_0123456789Sym3 l l l l + = forall arg. KindOf (Apply (Lambda_0123456789Sym3 l l l) arg) ~ KindOf (Lambda_0123456789Sym4 l l l arg) => + Lambda_0123456789Sym3KindInference + type instance Apply (Lambda_0123456789Sym3 l l l) l = Lambda_0123456789Sym4 l l l l + instance SuppressUnusedWarnings Lambda_0123456789Sym2 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym2KindInference GHC.Tuple.()) + data Lambda_0123456789Sym2 l l l + = forall arg. KindOf (Apply (Lambda_0123456789Sym2 l l) arg) ~ KindOf (Lambda_0123456789Sym3 l l arg) => + Lambda_0123456789Sym2KindInference + type instance Apply (Lambda_0123456789Sym2 l l) l = Lambda_0123456789Sym3 l l l + instance SuppressUnusedWarnings Lambda_0123456789Sym1 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym1KindInference GHC.Tuple.()) + data Lambda_0123456789Sym1 l l + = forall arg. KindOf (Apply (Lambda_0123456789Sym1 l) arg) ~ KindOf (Lambda_0123456789Sym2 l arg) => + Lambda_0123456789Sym1KindInference + type instance Apply (Lambda_0123456789Sym1 l) l = Lambda_0123456789Sym2 l l + instance SuppressUnusedWarnings Lambda_0123456789Sym0 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym0KindInference GHC.Tuple.()) + data Lambda_0123456789Sym0 l + = forall arg. KindOf (Apply Lambda_0123456789Sym0 arg) ~ KindOf (Lambda_0123456789Sym1 arg) => + Lambda_0123456789Sym0KindInference + type instance Apply Lambda_0123456789Sym0 l = Lambda_0123456789Sym1 l + type family Lambda_0123456789 a b t where + Lambda_0123456789 a b x = Apply (Apply (Apply Lambda_0123456789Sym0 a) b) x + type Lambda_0123456789Sym3 t t t = Lambda_0123456789 t t t + instance SuppressUnusedWarnings Lambda_0123456789Sym2 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym2KindInference GHC.Tuple.()) + data Lambda_0123456789Sym2 l l l + = forall arg. KindOf (Apply (Lambda_0123456789Sym2 l l) arg) ~ KindOf (Lambda_0123456789Sym3 l l arg) => + Lambda_0123456789Sym2KindInference + type instance Apply (Lambda_0123456789Sym2 l l) l = Lambda_0123456789Sym3 l l l + instance SuppressUnusedWarnings Lambda_0123456789Sym1 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym1KindInference GHC.Tuple.()) + data Lambda_0123456789Sym1 l l + = forall arg. KindOf (Apply (Lambda_0123456789Sym1 l) arg) ~ KindOf (Lambda_0123456789Sym2 l arg) => + Lambda_0123456789Sym1KindInference + type instance Apply (Lambda_0123456789Sym1 l) l = Lambda_0123456789Sym2 l l + instance SuppressUnusedWarnings Lambda_0123456789Sym0 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym0KindInference GHC.Tuple.()) + data Lambda_0123456789Sym0 l + = forall arg. KindOf (Apply Lambda_0123456789Sym0 arg) ~ KindOf (Lambda_0123456789Sym1 arg) => + Lambda_0123456789Sym0KindInference + type instance Apply Lambda_0123456789Sym0 l = Lambda_0123456789Sym1 l + type family Lambda_0123456789 x y t where + Lambda_0123456789 x y x = x + type Lambda_0123456789Sym3 t t t = Lambda_0123456789 t t t + instance SuppressUnusedWarnings Lambda_0123456789Sym2 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym2KindInference GHC.Tuple.()) + data Lambda_0123456789Sym2 l l l + = forall arg. KindOf (Apply (Lambda_0123456789Sym2 l l) arg) ~ KindOf (Lambda_0123456789Sym3 l l arg) => + Lambda_0123456789Sym2KindInference + type instance Apply (Lambda_0123456789Sym2 l l) l = Lambda_0123456789Sym3 l l l + instance SuppressUnusedWarnings Lambda_0123456789Sym1 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym1KindInference GHC.Tuple.()) + data Lambda_0123456789Sym1 l l + = forall arg. KindOf (Apply (Lambda_0123456789Sym1 l) arg) ~ KindOf (Lambda_0123456789Sym2 l arg) => + Lambda_0123456789Sym1KindInference + type instance Apply (Lambda_0123456789Sym1 l) l = Lambda_0123456789Sym2 l l + instance SuppressUnusedWarnings Lambda_0123456789Sym0 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym0KindInference GHC.Tuple.()) + data Lambda_0123456789Sym0 l + = forall arg. KindOf (Apply Lambda_0123456789Sym0 arg) ~ KindOf (Lambda_0123456789Sym1 arg) => + Lambda_0123456789Sym0KindInference + type instance Apply Lambda_0123456789Sym0 l = Lambda_0123456789Sym1 l + type family Case_0123456789 x + y + z + arg_0123456789 + arg_0123456789 + t where + Case_0123456789 x y z arg_0123456789 arg_0123456789 '(_z_0123456789, + _z_0123456789) = x + type family Lambda_0123456789 x y z t t where + Lambda_0123456789 x y z arg_0123456789 arg_0123456789 = Case_0123456789 x y z arg_0123456789 arg_0123456789 (Apply (Apply Tuple2Sym0 arg_0123456789) arg_0123456789) + type Lambda_0123456789Sym5 t t t t t = Lambda_0123456789 t t t t t + instance SuppressUnusedWarnings Lambda_0123456789Sym4 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym4KindInference GHC.Tuple.()) + data Lambda_0123456789Sym4 l l l l l + = forall arg. KindOf (Apply (Lambda_0123456789Sym4 l l l l) arg) ~ KindOf (Lambda_0123456789Sym5 l l l l arg) => + Lambda_0123456789Sym4KindInference + type instance Apply (Lambda_0123456789Sym4 l l l l) l = Lambda_0123456789Sym5 l l l l l + instance SuppressUnusedWarnings Lambda_0123456789Sym3 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym3KindInference GHC.Tuple.()) + data Lambda_0123456789Sym3 l l l l + = forall arg. KindOf (Apply (Lambda_0123456789Sym3 l l l) arg) ~ KindOf (Lambda_0123456789Sym4 l l l arg) => + Lambda_0123456789Sym3KindInference + type instance Apply (Lambda_0123456789Sym3 l l l) l = Lambda_0123456789Sym4 l l l l + instance SuppressUnusedWarnings Lambda_0123456789Sym2 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym2KindInference GHC.Tuple.()) + data Lambda_0123456789Sym2 l l l + = forall arg. KindOf (Apply (Lambda_0123456789Sym2 l l) arg) ~ KindOf (Lambda_0123456789Sym3 l l arg) => + Lambda_0123456789Sym2KindInference + type instance Apply (Lambda_0123456789Sym2 l l) l = Lambda_0123456789Sym3 l l l + instance SuppressUnusedWarnings Lambda_0123456789Sym1 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym1KindInference GHC.Tuple.()) + data Lambda_0123456789Sym1 l l + = forall arg. KindOf (Apply (Lambda_0123456789Sym1 l) arg) ~ KindOf (Lambda_0123456789Sym2 l arg) => + Lambda_0123456789Sym1KindInference + type instance Apply (Lambda_0123456789Sym1 l) l = Lambda_0123456789Sym2 l l + instance SuppressUnusedWarnings Lambda_0123456789Sym0 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym0KindInference GHC.Tuple.()) + data Lambda_0123456789Sym0 l + = forall arg. KindOf (Apply Lambda_0123456789Sym0 arg) ~ KindOf (Lambda_0123456789Sym1 arg) => + Lambda_0123456789Sym0KindInference + type instance Apply Lambda_0123456789Sym0 l = Lambda_0123456789Sym1 l + type family Lambda_0123456789 x t where + Lambda_0123456789 x y = y + type Lambda_0123456789Sym2 t t = Lambda_0123456789 t t + instance SuppressUnusedWarnings Lambda_0123456789Sym1 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym1KindInference GHC.Tuple.()) + data Lambda_0123456789Sym1 l l + = forall arg. KindOf (Apply (Lambda_0123456789Sym1 l) arg) ~ KindOf (Lambda_0123456789Sym2 l arg) => + Lambda_0123456789Sym1KindInference + type instance Apply (Lambda_0123456789Sym1 l) l = Lambda_0123456789Sym2 l l + instance SuppressUnusedWarnings Lambda_0123456789Sym0 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym0KindInference GHC.Tuple.()) + data Lambda_0123456789Sym0 l + = forall arg. KindOf (Apply Lambda_0123456789Sym0 arg) ~ KindOf (Lambda_0123456789Sym1 arg) => + Lambda_0123456789Sym0KindInference + type instance Apply Lambda_0123456789Sym0 l = Lambda_0123456789Sym1 l + type family Case_0123456789 x y arg_0123456789 t where + Case_0123456789 x y arg_0123456789 _z_0123456789 = x + type family Lambda_0123456789 x y t where + Lambda_0123456789 x y arg_0123456789 = Case_0123456789 x y arg_0123456789 arg_0123456789 + type Lambda_0123456789Sym3 t t t = Lambda_0123456789 t t t + instance SuppressUnusedWarnings Lambda_0123456789Sym2 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym2KindInference GHC.Tuple.()) + data Lambda_0123456789Sym2 l l l + = forall arg. KindOf (Apply (Lambda_0123456789Sym2 l l) arg) ~ KindOf (Lambda_0123456789Sym3 l l arg) => + Lambda_0123456789Sym2KindInference + type instance Apply (Lambda_0123456789Sym2 l l) l = Lambda_0123456789Sym3 l l l + instance SuppressUnusedWarnings Lambda_0123456789Sym1 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym1KindInference GHC.Tuple.()) + data Lambda_0123456789Sym1 l l + = forall arg. KindOf (Apply (Lambda_0123456789Sym1 l) arg) ~ KindOf (Lambda_0123456789Sym2 l arg) => + Lambda_0123456789Sym1KindInference + type instance Apply (Lambda_0123456789Sym1 l) l = Lambda_0123456789Sym2 l l + instance SuppressUnusedWarnings Lambda_0123456789Sym0 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym0KindInference GHC.Tuple.()) + data Lambda_0123456789Sym0 l + = forall arg. KindOf (Apply Lambda_0123456789Sym0 arg) ~ KindOf (Lambda_0123456789Sym1 arg) => + Lambda_0123456789Sym0KindInference + type instance Apply Lambda_0123456789Sym0 l = Lambda_0123456789Sym1 l + type family Case_0123456789 x arg_0123456789 a_0123456789 t where + Case_0123456789 x arg_0123456789 a_0123456789 _z_0123456789 = x + type family Lambda_0123456789 x a_0123456789 t where + Lambda_0123456789 x a_0123456789 arg_0123456789 = Case_0123456789 x arg_0123456789 a_0123456789 arg_0123456789 + type Lambda_0123456789Sym3 t t t = Lambda_0123456789 t t t + instance SuppressUnusedWarnings Lambda_0123456789Sym2 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym2KindInference GHC.Tuple.()) + data Lambda_0123456789Sym2 l l l + = forall arg. KindOf (Apply (Lambda_0123456789Sym2 l l) arg) ~ KindOf (Lambda_0123456789Sym3 l l arg) => + Lambda_0123456789Sym2KindInference + type instance Apply (Lambda_0123456789Sym2 l l) l = Lambda_0123456789Sym3 l l l + instance SuppressUnusedWarnings Lambda_0123456789Sym1 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym1KindInference GHC.Tuple.()) + data Lambda_0123456789Sym1 l l + = forall arg. KindOf (Apply (Lambda_0123456789Sym1 l) arg) ~ KindOf (Lambda_0123456789Sym2 l arg) => + Lambda_0123456789Sym1KindInference + type instance Apply (Lambda_0123456789Sym1 l) l = Lambda_0123456789Sym2 l l + instance SuppressUnusedWarnings Lambda_0123456789Sym0 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym0KindInference GHC.Tuple.()) + data Lambda_0123456789Sym0 l + = forall arg. KindOf (Apply Lambda_0123456789Sym0 arg) ~ KindOf (Lambda_0123456789Sym1 arg) => + Lambda_0123456789Sym0KindInference + type instance Apply Lambda_0123456789Sym0 l = Lambda_0123456789Sym1 l + type family Lambda_0123456789 a_0123456789 a_0123456789 t t where + Lambda_0123456789 a_0123456789 a_0123456789 x y = x + type Lambda_0123456789Sym4 t t t t = Lambda_0123456789 t t t t + instance SuppressUnusedWarnings Lambda_0123456789Sym3 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym3KindInference GHC.Tuple.()) + data Lambda_0123456789Sym3 l l l l + = forall arg. KindOf (Apply (Lambda_0123456789Sym3 l l l) arg) ~ KindOf (Lambda_0123456789Sym4 l l l arg) => + Lambda_0123456789Sym3KindInference + type instance Apply (Lambda_0123456789Sym3 l l l) l = Lambda_0123456789Sym4 l l l l + instance SuppressUnusedWarnings Lambda_0123456789Sym2 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym2KindInference GHC.Tuple.()) + data Lambda_0123456789Sym2 l l l + = forall arg. KindOf (Apply (Lambda_0123456789Sym2 l l) arg) ~ KindOf (Lambda_0123456789Sym3 l l arg) => + Lambda_0123456789Sym2KindInference + type instance Apply (Lambda_0123456789Sym2 l l) l = Lambda_0123456789Sym3 l l l + instance SuppressUnusedWarnings Lambda_0123456789Sym1 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym1KindInference GHC.Tuple.()) + data Lambda_0123456789Sym1 l l + = forall arg. KindOf (Apply (Lambda_0123456789Sym1 l) arg) ~ KindOf (Lambda_0123456789Sym2 l arg) => + Lambda_0123456789Sym1KindInference + type instance Apply (Lambda_0123456789Sym1 l) l = Lambda_0123456789Sym2 l l + instance SuppressUnusedWarnings Lambda_0123456789Sym0 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym0KindInference GHC.Tuple.()) + data Lambda_0123456789Sym0 l + = forall arg. KindOf (Apply Lambda_0123456789Sym0 arg) ~ KindOf (Lambda_0123456789Sym1 arg) => + Lambda_0123456789Sym0KindInference + type instance Apply Lambda_0123456789Sym0 l = Lambda_0123456789Sym1 l + type Foo8Sym1 (t :: Foo a0123456789 b0123456789) = Foo8 t + instance SuppressUnusedWarnings Foo8Sym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Foo8Sym0KindInference GHC.Tuple.()) + data Foo8Sym0 (l :: TyFun (Foo a0123456789 b0123456789) a0123456789) + = forall arg. KindOf (Apply Foo8Sym0 arg) ~ KindOf (Foo8Sym1 arg) => + Foo8Sym0KindInference + type instance Apply Foo8Sym0 l = Foo8Sym1 l + type Foo7Sym2 (t :: a0123456789) (t :: b0123456789) = Foo7 t t + instance SuppressUnusedWarnings Foo7Sym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Foo7Sym1KindInference GHC.Tuple.()) + data Foo7Sym1 (l :: a0123456789) + (l :: TyFun b0123456789 b0123456789) + = forall arg. KindOf (Apply (Foo7Sym1 l) arg) ~ KindOf (Foo7Sym2 l arg) => + Foo7Sym1KindInference + type instance Apply (Foo7Sym1 l) l = Foo7Sym2 l l + instance SuppressUnusedWarnings Foo7Sym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Foo7Sym0KindInference GHC.Tuple.()) + data Foo7Sym0 (l :: TyFun a0123456789 (TyFun b0123456789 b0123456789 + -> GHC.Types.Type)) + = forall arg. KindOf (Apply Foo7Sym0 arg) ~ KindOf (Foo7Sym1 arg) => + Foo7Sym0KindInference + type instance Apply Foo7Sym0 l = Foo7Sym1 l + type Foo6Sym2 (t :: a0123456789) (t :: b0123456789) = Foo6 t t + instance SuppressUnusedWarnings Foo6Sym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Foo6Sym1KindInference GHC.Tuple.()) + data Foo6Sym1 (l :: a0123456789) + (l :: TyFun b0123456789 a0123456789) + = forall arg. KindOf (Apply (Foo6Sym1 l) arg) ~ KindOf (Foo6Sym2 l arg) => + Foo6Sym1KindInference + type instance Apply (Foo6Sym1 l) l = Foo6Sym2 l l + instance SuppressUnusedWarnings Foo6Sym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Foo6Sym0KindInference GHC.Tuple.()) + data Foo6Sym0 (l :: TyFun a0123456789 (TyFun b0123456789 a0123456789 + -> GHC.Types.Type)) + = forall arg. KindOf (Apply Foo6Sym0 arg) ~ KindOf (Foo6Sym1 arg) => + Foo6Sym0KindInference + type instance Apply Foo6Sym0 l = Foo6Sym1 l + type Foo5Sym2 (t :: a0123456789) (t :: b0123456789) = Foo5 t t + instance SuppressUnusedWarnings Foo5Sym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Foo5Sym1KindInference GHC.Tuple.()) + data Foo5Sym1 (l :: a0123456789) + (l :: TyFun b0123456789 b0123456789) + = forall arg. KindOf (Apply (Foo5Sym1 l) arg) ~ KindOf (Foo5Sym2 l arg) => + Foo5Sym1KindInference + type instance Apply (Foo5Sym1 l) l = Foo5Sym2 l l + instance SuppressUnusedWarnings Foo5Sym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Foo5Sym0KindInference GHC.Tuple.()) + data Foo5Sym0 (l :: TyFun a0123456789 (TyFun b0123456789 b0123456789 + -> GHC.Types.Type)) + = forall arg. KindOf (Apply Foo5Sym0 arg) ~ KindOf (Foo5Sym1 arg) => + Foo5Sym0KindInference + type instance Apply Foo5Sym0 l = Foo5Sym1 l + type Foo4Sym3 (t :: a0123456789) + (t :: b0123456789) + (t :: c0123456789) = + Foo4 t t t + instance SuppressUnusedWarnings Foo4Sym2 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Foo4Sym2KindInference GHC.Tuple.()) + data Foo4Sym2 (l :: a0123456789) + (l :: b0123456789) + (l :: TyFun c0123456789 a0123456789) + = forall arg. KindOf (Apply (Foo4Sym2 l l) arg) ~ KindOf (Foo4Sym3 l l arg) => + Foo4Sym2KindInference + type instance Apply (Foo4Sym2 l l) l = Foo4Sym3 l l l + instance SuppressUnusedWarnings Foo4Sym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Foo4Sym1KindInference GHC.Tuple.()) + data Foo4Sym1 (l :: a0123456789) + (l :: TyFun b0123456789 (TyFun c0123456789 a0123456789 + -> GHC.Types.Type)) + = forall arg. KindOf (Apply (Foo4Sym1 l) arg) ~ KindOf (Foo4Sym2 l arg) => + Foo4Sym1KindInference + type instance Apply (Foo4Sym1 l) l = Foo4Sym2 l l + instance SuppressUnusedWarnings Foo4Sym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Foo4Sym0KindInference GHC.Tuple.()) + data Foo4Sym0 (l :: TyFun a0123456789 (TyFun b0123456789 (TyFun c0123456789 a0123456789 + -> GHC.Types.Type) + -> GHC.Types.Type)) + = forall arg. KindOf (Apply Foo4Sym0 arg) ~ KindOf (Foo4Sym1 arg) => + Foo4Sym0KindInference + type instance Apply Foo4Sym0 l = Foo4Sym1 l + type Foo3Sym1 (t :: a0123456789) = Foo3 t + instance SuppressUnusedWarnings Foo3Sym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Foo3Sym0KindInference GHC.Tuple.()) + data Foo3Sym0 (l :: TyFun a0123456789 a0123456789) + = forall arg. KindOf (Apply Foo3Sym0 arg) ~ KindOf (Foo3Sym1 arg) => + Foo3Sym0KindInference + type instance Apply Foo3Sym0 l = Foo3Sym1 l + type Foo2Sym2 (t :: a0123456789) (t :: b0123456789) = Foo2 t t + instance SuppressUnusedWarnings Foo2Sym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Foo2Sym1KindInference GHC.Tuple.()) + data Foo2Sym1 (l :: a0123456789) + (l :: TyFun b0123456789 a0123456789) + = forall arg. KindOf (Apply (Foo2Sym1 l) arg) ~ KindOf (Foo2Sym2 l arg) => + Foo2Sym1KindInference + type instance Apply (Foo2Sym1 l) l = Foo2Sym2 l l + instance SuppressUnusedWarnings Foo2Sym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Foo2Sym0KindInference GHC.Tuple.()) + data Foo2Sym0 (l :: TyFun a0123456789 (TyFun b0123456789 a0123456789 + -> GHC.Types.Type)) + = forall arg. KindOf (Apply Foo2Sym0 arg) ~ KindOf (Foo2Sym1 arg) => + Foo2Sym0KindInference + type instance Apply Foo2Sym0 l = Foo2Sym1 l + type Foo1Sym2 (t :: a0123456789) (t :: b0123456789) = Foo1 t t + instance SuppressUnusedWarnings Foo1Sym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Foo1Sym1KindInference GHC.Tuple.()) + data Foo1Sym1 (l :: a0123456789) + (l :: TyFun b0123456789 a0123456789) + = forall arg. KindOf (Apply (Foo1Sym1 l) arg) ~ KindOf (Foo1Sym2 l arg) => + Foo1Sym1KindInference + type instance Apply (Foo1Sym1 l) l = Foo1Sym2 l l + instance SuppressUnusedWarnings Foo1Sym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Foo1Sym0KindInference GHC.Tuple.()) + data Foo1Sym0 (l :: TyFun a0123456789 (TyFun b0123456789 a0123456789 + -> GHC.Types.Type)) + = forall arg. KindOf (Apply Foo1Sym0 arg) ~ KindOf (Foo1Sym1 arg) => + Foo1Sym0KindInference + type instance Apply Foo1Sym0 l = Foo1Sym1 l + type Foo0Sym2 (t :: a0123456789) (t :: b0123456789) = Foo0 t t + instance SuppressUnusedWarnings Foo0Sym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Foo0Sym1KindInference GHC.Tuple.()) + data Foo0Sym1 (l :: a0123456789) + (l :: TyFun b0123456789 a0123456789) + = forall arg. KindOf (Apply (Foo0Sym1 l) arg) ~ KindOf (Foo0Sym2 l arg) => + Foo0Sym1KindInference + type instance Apply (Foo0Sym1 l) l = Foo0Sym2 l l + instance SuppressUnusedWarnings Foo0Sym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Foo0Sym0KindInference GHC.Tuple.()) + data Foo0Sym0 (l :: TyFun a0123456789 (TyFun b0123456789 a0123456789 + -> GHC.Types.Type)) + = forall arg. KindOf (Apply Foo0Sym0 arg) ~ KindOf (Foo0Sym1 arg) => + Foo0Sym0KindInference + type instance Apply Foo0Sym0 l = Foo0Sym1 l + type family Foo8 (a :: Foo a b) :: a where + Foo8 x = Apply (Apply Lambda_0123456789Sym0 x) x + type family Foo7 (a :: a) (a :: b) :: b where + Foo7 x y = Apply (Apply (Apply Lambda_0123456789Sym0 x) y) (Apply (Apply Tuple2Sym0 x) y) + type family Foo6 (a :: a) (a :: b) :: a where + Foo6 a b = Apply (Apply (Apply (Apply Lambda_0123456789Sym0 a) b) a) b + type family Foo5 (a :: a) (a :: b) :: b where + Foo5 x y = Apply (Apply (Apply Lambda_0123456789Sym0 x) y) y + type family Foo4 (a :: a) (a :: b) (a :: c) :: a where + Foo4 x y z = Apply (Apply (Apply (Apply (Apply Lambda_0123456789Sym0 x) y) z) y) z + type family Foo3 (a :: a) :: a where + Foo3 x = Apply (Apply Lambda_0123456789Sym0 x) x + type family Foo2 (a :: a) (a :: b) :: a where + Foo2 x y = Apply (Apply (Apply Lambda_0123456789Sym0 x) y) y + type family Foo1 (a :: a) (a :: b) :: a where + Foo1 x a_0123456789 = Apply (Apply (Apply Lambda_0123456789Sym0 x) a_0123456789) a_0123456789 + type family Foo0 (a :: a) (a :: b) :: a where + Foo0 a_0123456789 a_0123456789 = Apply (Apply (Apply (Apply Lambda_0123456789Sym0 a_0123456789) a_0123456789) a_0123456789) a_0123456789 + sFoo8 :: + forall (t :: Foo a b). Sing t -> Sing (Apply Foo8Sym0 t :: a) + sFoo7 :: + forall (t :: a) (t :: b). + Sing t -> Sing t -> Sing (Apply (Apply Foo7Sym0 t) t :: b) + sFoo6 :: + forall (t :: a) (t :: b). + Sing t -> Sing t -> Sing (Apply (Apply Foo6Sym0 t) t :: a) + sFoo5 :: + forall (t :: a) (t :: b). + Sing t -> Sing t -> Sing (Apply (Apply Foo5Sym0 t) t :: b) + sFoo4 :: + forall (t :: a) (t :: b) (t :: c). + Sing t + -> Sing t + -> Sing t -> Sing (Apply (Apply (Apply Foo4Sym0 t) t) t :: a) + sFoo3 :: forall (t :: a). Sing t -> Sing (Apply Foo3Sym0 t :: a) + sFoo2 :: + forall (t :: a) (t :: b). + Sing t -> Sing t -> Sing (Apply (Apply Foo2Sym0 t) t :: a) + sFoo1 :: + forall (t :: a) (t :: b). + Sing t -> Sing t -> Sing (Apply (Apply Foo1Sym0 t) t :: a) + sFoo0 :: + forall (t :: a) (t :: b). + Sing t -> Sing t -> Sing (Apply (Apply Foo0Sym0 t) t :: a) + sFoo8 sX + = let + lambda :: forall x. t ~ x => Sing x -> Sing (Apply Foo8Sym0 t :: a) + lambda x + = applySing + (singFun1 + (Proxy :: Proxy (Apply Lambda_0123456789Sym0 x)) + (\ sArg_0123456789 + -> let + lambda :: + forall arg_0123456789. + Sing arg_0123456789 + -> Sing (Apply (Apply Lambda_0123456789Sym0 x) arg_0123456789) + lambda arg_0123456789 + = case arg_0123456789 of { + SFoo sA _s_z_0123456789 + -> let + lambda :: + forall a _z_0123456789. + Apply (Apply FooSym0 a) _z_0123456789 ~ arg_0123456789 => + Sing a + -> Sing _z_0123456789 + -> Sing (Case_0123456789 x arg_0123456789 (Apply (Apply FooSym0 a) _z_0123456789)) + lambda a _z_0123456789 = a + in lambda sA _s_z_0123456789 } :: + Sing (Case_0123456789 x arg_0123456789 arg_0123456789) + in lambda sArg_0123456789)) + x + in lambda sX + sFoo7 sX sY + = let + lambda :: + forall x y. + (t ~ x, t ~ y) => + Sing x -> Sing y -> Sing (Apply (Apply Foo7Sym0 t) t :: b) + lambda x y + = applySing + (singFun1 + (Proxy :: Proxy (Apply (Apply Lambda_0123456789Sym0 x) y)) + (\ sArg_0123456789 + -> let + lambda :: + forall arg_0123456789. + Sing arg_0123456789 + -> Sing (Apply (Apply (Apply Lambda_0123456789Sym0 x) y) arg_0123456789) + lambda arg_0123456789 + = case arg_0123456789 of { + STuple2 _s_z_0123456789 sB + -> let + lambda :: + forall _z_0123456789 b. + Apply (Apply Tuple2Sym0 _z_0123456789) b ~ arg_0123456789 => + Sing _z_0123456789 + -> Sing b + -> Sing (Case_0123456789 x y arg_0123456789 (Apply (Apply Tuple2Sym0 _z_0123456789) b)) + lambda _z_0123456789 b = b + in lambda _s_z_0123456789 sB } :: + Sing (Case_0123456789 x y arg_0123456789 arg_0123456789) + in lambda sArg_0123456789)) + (applySing + (applySing (singFun2 (Proxy :: Proxy Tuple2Sym0) STuple2) x) y) + in lambda sX sY + sFoo6 sA sB + = let + lambda :: + forall a b. + (t ~ a, t ~ b) => + Sing a -> Sing b -> Sing (Apply (Apply Foo6Sym0 t) t :: a) + lambda a b + = applySing + (applySing + (singFun1 + (Proxy :: Proxy (Apply (Apply Lambda_0123456789Sym0 a) b)) + (\ sX + -> let + lambda :: + forall x. + Sing x -> Sing (Apply (Apply (Apply Lambda_0123456789Sym0 a) b) x) + lambda x + = singFun1 + (Proxy :: + Proxy (Apply (Apply (Apply Lambda_0123456789Sym0 a) b) x)) + (\ sArg_0123456789 + -> let + lambda :: + forall arg_0123456789. + Sing arg_0123456789 + -> Sing (Apply (Apply (Apply (Apply Lambda_0123456789Sym0 a) b) x) arg_0123456789) + lambda arg_0123456789 + = case arg_0123456789 of { + _s_z_0123456789 + -> let + lambda :: + forall _z_0123456789. + _z_0123456789 ~ arg_0123456789 => + Sing _z_0123456789 + -> Sing (Case_0123456789 a b x arg_0123456789 _z_0123456789) + lambda _z_0123456789 = x + in lambda _s_z_0123456789 } :: + Sing (Case_0123456789 a b x arg_0123456789 arg_0123456789) + in lambda sArg_0123456789) + in lambda sX)) + a) + b + in lambda sA sB + sFoo5 sX sY + = let + lambda :: + forall x y. + (t ~ x, t ~ y) => + Sing x -> Sing y -> Sing (Apply (Apply Foo5Sym0 t) t :: b) + lambda x y + = applySing + (singFun1 + (Proxy :: Proxy (Apply (Apply Lambda_0123456789Sym0 x) y)) + (\ sX + -> let + lambda :: + forall x. + Sing x -> Sing (Apply (Apply (Apply Lambda_0123456789Sym0 x) y) x) + lambda x = x + in lambda sX)) + y + in lambda sX sY + sFoo4 sX sY sZ + = let + lambda :: + forall x y z. + (t ~ x, t ~ y, t ~ z) => + Sing x + -> Sing y + -> Sing z -> Sing (Apply (Apply (Apply Foo4Sym0 t) t) t :: a) + lambda x y z + = applySing + (applySing + (singFun2 + (Proxy :: + Proxy (Apply (Apply (Apply Lambda_0123456789Sym0 x) y) z)) + (\ sArg_0123456789 sArg_0123456789 + -> let + lambda :: + forall arg_0123456789 arg_0123456789. + Sing arg_0123456789 + -> Sing arg_0123456789 + -> Sing (Apply (Apply (Apply (Apply (Apply Lambda_0123456789Sym0 x) y) z) arg_0123456789) arg_0123456789) + lambda arg_0123456789 arg_0123456789 + = case + applySing + (applySing + (singFun2 (Proxy :: Proxy Tuple2Sym0) STuple2) + arg_0123456789) + arg_0123456789 + of { + STuple2 _s_z_0123456789 _s_z_0123456789 + -> let + lambda :: + forall _z_0123456789 _z_0123456789. + Apply (Apply Tuple2Sym0 _z_0123456789) _z_0123456789 ~ Apply (Apply Tuple2Sym0 arg_0123456789) arg_0123456789 => + Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing (Case_0123456789 x y z arg_0123456789 arg_0123456789 (Apply (Apply Tuple2Sym0 _z_0123456789) _z_0123456789)) + lambda _z_0123456789 _z_0123456789 = x + in lambda _s_z_0123456789 _s_z_0123456789 } :: + Sing (Case_0123456789 x y z arg_0123456789 arg_0123456789 (Apply (Apply Tuple2Sym0 arg_0123456789) arg_0123456789)) + in lambda sArg_0123456789 sArg_0123456789)) + y) + z + in lambda sX sY sZ + sFoo3 sX + = let + lambda :: forall x. t ~ x => Sing x -> Sing (Apply Foo3Sym0 t :: a) + lambda x + = applySing + (singFun1 + (Proxy :: Proxy (Apply Lambda_0123456789Sym0 x)) + (\ sY + -> let + lambda :: + forall y. Sing y -> Sing (Apply (Apply Lambda_0123456789Sym0 x) y) + lambda y = y + in lambda sY)) + x + in lambda sX + sFoo2 sX sY + = let + lambda :: + forall x y. + (t ~ x, t ~ y) => + Sing x -> Sing y -> Sing (Apply (Apply Foo2Sym0 t) t :: a) + lambda x y + = applySing + (singFun1 + (Proxy :: Proxy (Apply (Apply Lambda_0123456789Sym0 x) y)) + (\ sArg_0123456789 + -> let + lambda :: + forall arg_0123456789. + Sing arg_0123456789 + -> Sing (Apply (Apply (Apply Lambda_0123456789Sym0 x) y) arg_0123456789) + lambda arg_0123456789 + = case arg_0123456789 of { + _s_z_0123456789 + -> let + lambda :: + forall _z_0123456789. + _z_0123456789 ~ arg_0123456789 => + Sing _z_0123456789 + -> Sing (Case_0123456789 x y arg_0123456789 _z_0123456789) + lambda _z_0123456789 = x + in lambda _s_z_0123456789 } :: + Sing (Case_0123456789 x y arg_0123456789 arg_0123456789) + in lambda sArg_0123456789)) + y + in lambda sX sY + sFoo1 sX sA_0123456789 + = let + lambda :: + forall x a_0123456789. + (t ~ x, t ~ a_0123456789) => + Sing x + -> Sing a_0123456789 -> Sing (Apply (Apply Foo1Sym0 t) t :: a) + lambda x a_0123456789 + = applySing + (singFun1 + (Proxy :: + Proxy (Apply (Apply Lambda_0123456789Sym0 x) a_0123456789)) + (\ sArg_0123456789 + -> let + lambda :: + forall arg_0123456789. + Sing arg_0123456789 + -> Sing (Apply (Apply (Apply Lambda_0123456789Sym0 x) a_0123456789) arg_0123456789) + lambda arg_0123456789 + = case arg_0123456789 of { + _s_z_0123456789 + -> let + lambda :: + forall _z_0123456789. + _z_0123456789 ~ arg_0123456789 => + Sing _z_0123456789 + -> Sing (Case_0123456789 x arg_0123456789 a_0123456789 _z_0123456789) + lambda _z_0123456789 = x + in lambda _s_z_0123456789 } :: + Sing (Case_0123456789 x arg_0123456789 a_0123456789 arg_0123456789) + in lambda sArg_0123456789)) + a_0123456789 + in lambda sX sA_0123456789 + sFoo0 sA_0123456789 sA_0123456789 + = let + lambda :: + forall a_0123456789 a_0123456789. + (t ~ a_0123456789, t ~ a_0123456789) => + Sing a_0123456789 + -> Sing a_0123456789 -> Sing (Apply (Apply Foo0Sym0 t) t :: a) + lambda a_0123456789 a_0123456789 + = applySing + (applySing + (singFun2 + (Proxy :: + Proxy (Apply (Apply Lambda_0123456789Sym0 a_0123456789) a_0123456789)) + (\ sX sY + -> let + lambda :: + forall x y. + Sing x + -> Sing y + -> Sing (Apply (Apply (Apply (Apply Lambda_0123456789Sym0 a_0123456789) a_0123456789) x) y) + lambda x y = x + in lambda sX sY)) + a_0123456789) + a_0123456789 + in lambda sA_0123456789 sA_0123456789 + data instance Sing (z :: Foo a b) + = forall (n :: a) (n :: b). z ~ Foo n n => + SFoo (Sing (n :: a)) (Sing (n :: b)) + type SFoo = (Sing :: Foo a b -> GHC.Types.Type) + instance (SingKind (KProxy :: KProxy a), + SingKind (KProxy :: KProxy b)) => + SingKind (KProxy :: KProxy (Foo a b)) where + type DemoteRep (KProxy :: KProxy (Foo a b)) = Foo (DemoteRep (KProxy :: KProxy a)) (DemoteRep (KProxy :: KProxy b)) + fromSing (SFoo b b) = Foo (fromSing b) (fromSing b) + toSing (Foo b b) + = case + GHC.Tuple.(,) + (toSing b :: SomeSing (KProxy :: KProxy a)) + (toSing b :: SomeSing (KProxy :: KProxy b)) + of { + GHC.Tuple.(,) (SomeSing c) (SomeSing c) -> SomeSing (SFoo c c) } + instance (SingI n, SingI n) => SingI (Foo (n :: a) (n :: b)) where + sing = SFoo sing sing diff --git a/tests/compile-and-dump/Singletons/LambdasComprehensive.ghc80.template b/tests/compile-and-dump/Singletons/LambdasComprehensive.ghc80.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/LambdasComprehensive.ghc80.template @@ -0,0 +1,81 @@ +Singletons/LambdasComprehensive.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| foo :: [Nat] + foo + = map (\ x -> either_ pred Succ x) [Left Zero, Right (Succ Zero)] + bar :: [Nat] + bar = map (either_ pred Succ) [Left Zero, Right (Succ Zero)] |] + ======> + foo :: [Nat] + foo + = map (\ x -> either_ pred Succ x) [Left Zero, Right (Succ Zero)] + bar :: [Nat] + bar = map (either_ pred Succ) [Left Zero, Right (Succ Zero)] + type family Lambda_0123456789 t where + Lambda_0123456789 x = Apply (Apply (Apply Either_Sym0 PredSym0) SuccSym0) x + type Lambda_0123456789Sym1 t = Lambda_0123456789 t + instance SuppressUnusedWarnings Lambda_0123456789Sym0 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym0KindInference GHC.Tuple.()) + data Lambda_0123456789Sym0 l + = forall arg. KindOf (Apply Lambda_0123456789Sym0 arg) ~ KindOf (Lambda_0123456789Sym1 arg) => + Lambda_0123456789Sym0KindInference + type instance Apply Lambda_0123456789Sym0 l = Lambda_0123456789Sym1 l + type BarSym0 = Bar + type FooSym0 = Foo + type family Bar :: [Nat] where + Bar = Apply (Apply MapSym0 (Apply (Apply Either_Sym0 PredSym0) SuccSym0)) (Apply (Apply (:$) (Apply LeftSym0 ZeroSym0)) (Apply (Apply (:$) (Apply RightSym0 (Apply SuccSym0 ZeroSym0))) '[])) + type family Foo :: [Nat] where + Foo = Apply (Apply MapSym0 Lambda_0123456789Sym0) (Apply (Apply (:$) (Apply LeftSym0 ZeroSym0)) (Apply (Apply (:$) (Apply RightSym0 (Apply SuccSym0 ZeroSym0))) '[])) + sBar :: Sing (BarSym0 :: [Nat]) + sFoo :: Sing (FooSym0 :: [Nat]) + sBar + = applySing + (applySing + (singFun2 (Proxy :: Proxy MapSym0) sMap) + (applySing + (applySing + (singFun3 (Proxy :: Proxy Either_Sym0) sEither_) + (singFun1 (Proxy :: Proxy PredSym0) sPred)) + (singFun1 (Proxy :: Proxy SuccSym0) SSucc))) + (applySing + (applySing + (singFun2 (Proxy :: Proxy (:$)) SCons) + (applySing (singFun1 (Proxy :: Proxy LeftSym0) SLeft) SZero)) + (applySing + (applySing + (singFun2 (Proxy :: Proxy (:$)) SCons) + (applySing + (singFun1 (Proxy :: Proxy RightSym0) SRight) + (applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) SZero))) + SNil)) + sFoo + = applySing + (applySing + (singFun2 (Proxy :: Proxy MapSym0) sMap) + (singFun1 + (Proxy :: Proxy Lambda_0123456789Sym0) + (\ sX + -> let + lambda :: forall x. Sing x -> Sing (Apply Lambda_0123456789Sym0 x) + lambda x + = applySing + (applySing + (applySing + (singFun3 (Proxy :: Proxy Either_Sym0) sEither_) + (singFun1 (Proxy :: Proxy PredSym0) sPred)) + (singFun1 (Proxy :: Proxy SuccSym0) SSucc)) + x + in lambda sX))) + (applySing + (applySing + (singFun2 (Proxy :: Proxy (:$)) SCons) + (applySing (singFun1 (Proxy :: Proxy LeftSym0) SLeft) SZero)) + (applySing + (applySing + (singFun2 (Proxy :: Proxy (:$)) SCons) + (applySing + (singFun1 (Proxy :: Proxy RightSym0) SRight) + (applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) SZero))) + SNil)) diff --git a/tests/compile-and-dump/Singletons/LetStatements.ghc710.template b/tests/compile-and-dump/Singletons/LetStatements.ghc710.template --- a/tests/compile-and-dump/Singletons/LetStatements.ghc710.template +++ b/tests/compile-and-dump/Singletons/LetStatements.ghc710.template @@ -519,19 +519,19 @@ = forall arg. KindOf (Apply Foo14Sym0 arg) ~ KindOf (Foo14Sym1 arg) => Foo14Sym0KindInference type instance Apply Foo14Sym0 l = Foo14Sym1 l - type Foo13_Sym1 (t :: a) = Foo13_ t + type Foo13_Sym1 (t :: a0123456789) = Foo13_ t instance SuppressUnusedWarnings Foo13_Sym0 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) Foo13_Sym0KindInference GHC.Tuple.()) - data Foo13_Sym0 (l :: TyFun a a) + data Foo13_Sym0 (l :: TyFun a0123456789 a0123456789) = forall arg. KindOf (Apply Foo13_Sym0 arg) ~ KindOf (Foo13_Sym1 arg) => Foo13_Sym0KindInference type instance Apply Foo13_Sym0 l = Foo13_Sym1 l - type Foo13Sym1 (t :: a) = Foo13 t + type Foo13Sym1 (t :: a0123456789) = Foo13 t instance SuppressUnusedWarnings Foo13Sym0 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) Foo13Sym0KindInference GHC.Tuple.()) - data Foo13Sym0 (l :: TyFun a a) + data Foo13Sym0 (l :: TyFun a0123456789 a0123456789) = forall arg. KindOf (Apply Foo13Sym0 arg) ~ KindOf (Foo13Sym1 arg) => Foo13Sym0KindInference type instance Apply Foo13Sym0 l = Foo13Sym1 l @@ -685,7 +685,7 @@ sFoo14 sX = let lambda :: - forall x. t ~ x => Sing x -> Sing (Apply Foo14Sym0 x :: (Nat, Nat)) + forall x. t ~ x => Sing x -> Sing (Apply Foo14Sym0 t :: (Nat, Nat)) lambda x = let sY :: Sing (Let0123456789YSym1 x) @@ -730,13 +730,13 @@ sFoo13_ sY = let lambda :: - forall y. t ~ y => Sing y -> Sing (Apply Foo13_Sym0 y :: a) + forall y. t ~ y => Sing y -> Sing (Apply Foo13_Sym0 t :: a) lambda y = y in lambda sY sFoo13 sX = let lambda :: - forall x. t ~ x => Sing x -> Sing (Apply Foo13Sym0 x :: a) + forall x. t ~ x => Sing x -> Sing (Apply Foo13Sym0 t :: a) lambda x = let sBar :: Sing (Let0123456789BarSym1 x :: a) @@ -746,7 +746,7 @@ sFoo12 sX = let lambda :: - forall x. t ~ x => Sing x -> Sing (Apply Foo12Sym0 x :: Nat) + forall x. t ~ x => Sing x -> Sing (Apply Foo12Sym0 t :: Nat) lambda x = let (%:+) :: @@ -758,8 +758,7 @@ = let lambda :: forall m. (t ~ ZeroSym0, t ~ m) => - Sing m - -> Sing (Apply (Apply ((:<<<%%%%%%%%%%:+$$) x) ZeroSym0) m :: Nat) + Sing m -> Sing (Apply (Apply ((:<<<%%%%%%%%%%:+$$) x) t) t :: Nat) lambda m = m in lambda sM (%:+) (SSucc sN) sM @@ -768,7 +767,7 @@ forall n m. (t ~ Apply SuccSym0 n, t ~ m) => Sing n -> Sing m - -> Sing (Apply (Apply ((:<<<%%%%%%%%%%:+$$) x) (Apply SuccSym0 n)) m :: Nat) + -> Sing (Apply (Apply ((:<<<%%%%%%%%%%:+$$) x) t) t :: Nat) lambda n m = applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) @@ -788,7 +787,7 @@ sFoo11 sX = let lambda :: - forall x. t ~ x => Sing x -> Sing (Apply Foo11Sym0 x :: Nat) + forall x. t ~ x => Sing x -> Sing (Apply Foo11Sym0 t :: Nat) lambda x = let sZ :: Sing (Let0123456789ZSym1 x :: Nat) @@ -802,8 +801,7 @@ = let lambda :: forall m. (t ~ ZeroSym0, t ~ m) => - Sing m - -> Sing (Apply (Apply ((:<<<%%%%%%%%%%:+$$) x) ZeroSym0) m :: Nat) + Sing m -> Sing (Apply (Apply ((:<<<%%%%%%%%%%:+$$) x) t) t :: Nat) lambda m = m in lambda sM (%:+) (SSucc sN) sM @@ -812,7 +810,7 @@ forall n m. (t ~ Apply SuccSym0 n, t ~ m) => Sing n -> Sing m - -> Sing (Apply (Apply ((:<<<%%%%%%%%%%:+$$) x) (Apply SuccSym0 n)) m :: Nat) + -> Sing (Apply (Apply ((:<<<%%%%%%%%%%:+$$) x) t) t :: Nat) lambda n m = applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) @@ -831,7 +829,7 @@ sFoo10 sX = let lambda :: - forall x. t ~ x => Sing x -> Sing (Apply Foo10Sym0 x :: Nat) + forall x. t ~ x => Sing x -> Sing (Apply Foo10Sym0 t :: Nat) lambda x = let (%:+) :: @@ -843,8 +841,7 @@ = let lambda :: forall m. (t ~ ZeroSym0, t ~ m) => - Sing m - -> Sing (Apply (Apply ((:<<<%%%%%%%%%%:+$$) x) ZeroSym0) m :: Nat) + Sing m -> Sing (Apply (Apply ((:<<<%%%%%%%%%%:+$$) x) t) t :: Nat) lambda m = m in lambda sM (%:+) (SSucc sN) sM @@ -853,7 +850,7 @@ forall n m. (t ~ Apply SuccSym0 n, t ~ m) => Sing n -> Sing m - -> Sing (Apply (Apply ((:<<<%%%%%%%%%%:+$$) x) (Apply SuccSym0 n)) m :: Nat) + -> Sing (Apply (Apply ((:<<<%%%%%%%%%%:+$$) x) t) t :: Nat) lambda n m = applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) @@ -872,7 +869,7 @@ sFoo9 sX = let lambda :: - forall x. t ~ x => Sing x -> Sing (Apply Foo9Sym0 x :: Nat) + forall x. t ~ x => Sing x -> Sing (Apply Foo9Sym0 t :: Nat) lambda x = let sZ :: @@ -882,8 +879,7 @@ = let lambda :: forall a_0123456789. t ~ a_0123456789 => - Sing a_0123456789 - -> Sing (Apply (Let0123456789ZSym1 x) a_0123456789 :: Nat) + Sing a_0123456789 -> Sing (Apply (Let0123456789ZSym1 x) t :: Nat) lambda a_0123456789 = applySing (singFun1 @@ -905,7 +901,7 @@ sFoo8 sX = let lambda :: - forall x. t ~ x => Sing x -> Sing (Apply Foo8Sym0 x :: Nat) + forall x. t ~ x => Sing x -> Sing (Apply Foo8Sym0 t :: Nat) lambda x = let sZ :: Sing (Let0123456789ZSym1 x :: Nat) @@ -926,7 +922,7 @@ sFoo7 sX = let lambda :: - forall x. t ~ x => Sing x -> Sing (Apply Foo7Sym0 x :: Nat) + forall x. t ~ x => Sing x -> Sing (Apply Foo7Sym0 t :: Nat) lambda x = let sX :: Sing (Let0123456789XSym1 x :: Nat) @@ -936,7 +932,7 @@ sFoo6 sX = let lambda :: - forall x. t ~ x => Sing x -> Sing (Apply Foo6Sym0 x :: Nat) + forall x. t ~ x => Sing x -> Sing (Apply Foo6Sym0 t :: Nat) lambda x = let sF :: @@ -946,7 +942,7 @@ = let lambda :: forall y. t ~ y => - Sing y -> Sing (Apply (Let0123456789FSym1 x) y :: Nat) + Sing y -> Sing (Apply (Let0123456789FSym1 x) t :: Nat) lambda y = applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) y in lambda sY in let @@ -958,7 +954,7 @@ sFoo5 sX = let lambda :: - forall x. t ~ x => Sing x -> Sing (Apply Foo5Sym0 x :: Nat) + forall x. t ~ x => Sing x -> Sing (Apply Foo5Sym0 t :: Nat) lambda x = let sF :: @@ -968,7 +964,7 @@ = let lambda :: forall y. t ~ y => - Sing y -> Sing (Apply (Let0123456789FSym1 x) y :: Nat) + Sing y -> Sing (Apply (Let0123456789FSym1 x) t :: Nat) lambda y = let sZ :: Sing (Let0123456789ZSym2 x y :: Nat) @@ -981,7 +977,7 @@ sFoo4 sX = let lambda :: - forall x. t ~ x => Sing x -> Sing (Apply Foo4Sym0 x :: Nat) + forall x. t ~ x => Sing x -> Sing (Apply Foo4Sym0 t :: Nat) lambda x = let sF :: @@ -991,7 +987,7 @@ = let lambda :: forall y. t ~ y => - Sing y -> Sing (Apply (Let0123456789FSym1 x) y :: Nat) + Sing y -> Sing (Apply (Let0123456789FSym1 x) t :: Nat) lambda y = applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) y in lambda sY in @@ -1000,7 +996,7 @@ sFoo3 sX = let lambda :: - forall x. t ~ x => Sing x -> Sing (Apply Foo3Sym0 x :: Nat) + forall x. t ~ x => Sing x -> Sing (Apply Foo3Sym0 t :: Nat) lambda x = let sY :: Sing (Let0123456789YSym1 x :: Nat) @@ -1017,7 +1013,7 @@ sFoo1 sX = let lambda :: - forall x. t ~ x => Sing x -> Sing (Apply Foo1Sym0 x :: Nat) + forall x. t ~ x => Sing x -> Sing (Apply Foo1Sym0 t :: Nat) lambda x = let sY :: Sing (Let0123456789YSym1 x :: Nat) diff --git a/tests/compile-and-dump/Singletons/LetStatements.ghc80.template b/tests/compile-and-dump/Singletons/LetStatements.ghc80.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/LetStatements.ghc80.template @@ -0,0 +1,1032 @@ +Singletons/LetStatements.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| foo1 :: Nat -> Nat + foo1 x + = let + y :: Nat + y = Succ Zero + in y + foo2 :: Nat + foo2 + = let + y = Succ Zero + z = Succ y + in z + foo3 :: Nat -> Nat + foo3 x + = let + y :: Nat + y = Succ x + in y + foo4 :: Nat -> Nat + foo4 x + = let + f :: Nat -> Nat + f y = Succ y + in f x + foo5 :: Nat -> Nat + foo5 x + = let + f :: Nat -> Nat + f y + = let + z :: Nat + z = Succ y + in Succ z + in f x + foo6 :: Nat -> Nat + foo6 x + = let + f :: Nat -> Nat + f y = Succ y in + let + z :: Nat + z = f x + in z + foo7 :: Nat -> Nat + foo7 x + = let + x :: Nat + x = Zero + in x + foo8 :: Nat -> Nat + foo8 x + = let + z :: Nat + z = (\ x -> x) Zero + in z + foo9 :: Nat -> Nat + foo9 x + = let + z :: Nat -> Nat + z = (\ x -> x) + in z x + foo10 :: Nat -> Nat + foo10 x + = let + (+) :: Nat -> Nat -> Nat + Zero + m = m + (Succ n) + m = Succ (n + m) + in (Succ Zero) + x + foo11 :: Nat -> Nat + foo11 x + = let + (+) :: Nat -> Nat -> Nat + Zero + m = m + (Succ n) + m = Succ (n + m) + z :: Nat + z = x + in (Succ Zero) + z + foo12 :: Nat -> Nat + foo12 x + = let + (+) :: Nat -> Nat -> Nat + Zero + m = m + (Succ n) + m = Succ (n + x) + in x + (Succ (Succ Zero)) + foo13 :: forall a. a -> a + foo13 x + = let + bar :: a + bar = x + in foo13_ bar + foo13_ :: a -> a + foo13_ y = y + foo14 :: Nat -> (Nat, Nat) + foo14 x = let (y, z) = (Succ x, x) in (z, y) |] + ======> + foo1 :: Nat -> Nat + foo1 x + = let + y :: Nat + y = Succ Zero + in y + foo2 :: Nat + foo2 + = let + y = Succ Zero + z = Succ y + in z + foo3 :: Nat -> Nat + foo3 x + = let + y :: Nat + y = Succ x + in y + foo4 :: Nat -> Nat + foo4 x + = let + f :: Nat -> Nat + f y = Succ y + in f x + foo5 :: Nat -> Nat + foo5 x + = let + f :: Nat -> Nat + f y + = let + z :: Nat + z = Succ y + in Succ z + in f x + foo6 :: Nat -> Nat + foo6 x + = let + f :: Nat -> Nat + f y = Succ y in + let + z :: Nat + z = f x + in z + foo7 :: Nat -> Nat + foo7 x + = let + x :: Nat + x = Zero + in x + foo8 :: Nat -> Nat + foo8 x + = let + z :: Nat + z = (\ x -> x) Zero + in z + foo9 :: Nat -> Nat + foo9 x + = let + z :: Nat -> Nat + z = \ x -> x + in z x + foo10 :: Nat -> Nat + foo10 x + = let + (+) :: Nat -> Nat -> Nat + (+) Zero m = m + (+) (Succ n) m = Succ (n + m) + in ((Succ Zero) + x) + foo11 :: Nat -> Nat + foo11 x + = let + (+) :: Nat -> Nat -> Nat + z :: Nat + (+) Zero m = m + (+) (Succ n) m = Succ (n + m) + z = x + in ((Succ Zero) + z) + foo12 :: Nat -> Nat + foo12 x + = let + (+) :: Nat -> Nat -> Nat + (+) Zero m = m + (+) (Succ n) m = Succ (n + x) + in (x + (Succ (Succ Zero))) + foo13 :: forall a. a -> a + foo13 x + = let + bar :: a + bar = x + in foo13_ bar + foo13_ :: forall a. a -> a + foo13_ y = y + foo14 :: Nat -> (Nat, Nat) + foo14 x = let (y, z) = (Succ x, x) in (z, y) + type family Case_0123456789 x t where + Case_0123456789 x '(y_0123456789, _z_0123456789) = y_0123456789 + type family Case_0123456789 x t where + Case_0123456789 x '(_z_0123456789, y_0123456789) = y_0123456789 + type Let0123456789YSym1 t = Let0123456789Y t + instance SuppressUnusedWarnings Let0123456789YSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Let0123456789YSym0KindInference GHC.Tuple.()) + data Let0123456789YSym0 l + = forall arg. KindOf (Apply Let0123456789YSym0 arg) ~ KindOf (Let0123456789YSym1 arg) => + Let0123456789YSym0KindInference + type instance Apply Let0123456789YSym0 l = Let0123456789YSym1 l + type Let0123456789ZSym1 t = Let0123456789Z t + instance SuppressUnusedWarnings Let0123456789ZSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Let0123456789ZSym0KindInference GHC.Tuple.()) + data Let0123456789ZSym0 l + = forall arg. KindOf (Apply Let0123456789ZSym0 arg) ~ KindOf (Let0123456789ZSym1 arg) => + Let0123456789ZSym0KindInference + type instance Apply Let0123456789ZSym0 l = Let0123456789ZSym1 l + type Let0123456789X_0123456789Sym1 t = Let0123456789X_0123456789 t + instance SuppressUnusedWarnings Let0123456789X_0123456789Sym0 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) + Let0123456789X_0123456789Sym0KindInference GHC.Tuple.()) + data Let0123456789X_0123456789Sym0 l + = forall arg. KindOf (Apply Let0123456789X_0123456789Sym0 arg) ~ KindOf (Let0123456789X_0123456789Sym1 arg) => + Let0123456789X_0123456789Sym0KindInference + type instance Apply Let0123456789X_0123456789Sym0 l = Let0123456789X_0123456789Sym1 l + type family Let0123456789Y x where + Let0123456789Y x = Case_0123456789 x (Let0123456789X_0123456789Sym1 x) + type family Let0123456789Z x where + Let0123456789Z x = Case_0123456789 x (Let0123456789X_0123456789Sym1 x) + type family Let0123456789X_0123456789 x where + Let0123456789X_0123456789 x = Apply (Apply Tuple2Sym0 (Apply SuccSym0 x)) x + type Let0123456789BarSym1 t = Let0123456789Bar t + instance SuppressUnusedWarnings Let0123456789BarSym0 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Let0123456789BarSym0KindInference GHC.Tuple.()) + data Let0123456789BarSym0 l + = forall arg. KindOf (Apply Let0123456789BarSym0 arg) ~ KindOf (Let0123456789BarSym1 arg) => + Let0123456789BarSym0KindInference + type instance Apply Let0123456789BarSym0 l = Let0123456789BarSym1 l + type family Let0123456789Bar x :: a where + Let0123456789Bar x = x + type (:<<<%%%%%%%%%%:+$$$$) t (t :: Nat) (t :: Nat) = + (:<<<%%%%%%%%%%:+) t t t + instance SuppressUnusedWarnings (:<<<%%%%%%%%%%:+$$$) where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) (:<<<%%%%%%%%%%:+$$$###) GHC.Tuple.()) + data (:<<<%%%%%%%%%%:+$$$) l (l :: Nat) (l :: TyFun Nat Nat) + = forall arg. KindOf (Apply ((:<<<%%%%%%%%%%:+$$$) l l) arg) ~ KindOf ((:<<<%%%%%%%%%%:+$$$$) l l arg) => + (:<<<%%%%%%%%%%:+$$$###) + type instance Apply ((:<<<%%%%%%%%%%:+$$$) l l) l = (:<<<%%%%%%%%%%:+$$$$) l l l + instance SuppressUnusedWarnings (:<<<%%%%%%%%%%:+$$) where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) (:<<<%%%%%%%%%%:+$$###) GHC.Tuple.()) + data (:<<<%%%%%%%%%%:+$$) l + (l :: TyFun Nat (TyFun Nat Nat -> GHC.Types.Type)) + = forall arg. KindOf (Apply ((:<<<%%%%%%%%%%:+$$) l) arg) ~ KindOf ((:<<<%%%%%%%%%%:+$$$) l arg) => + (:<<<%%%%%%%%%%:+$$###) + type instance Apply ((:<<<%%%%%%%%%%:+$$) l) l = (:<<<%%%%%%%%%%:+$$$) l l + instance SuppressUnusedWarnings (:<<<%%%%%%%%%%:+$) where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) (:<<<%%%%%%%%%%:+$###) GHC.Tuple.()) + data (:<<<%%%%%%%%%%:+$) l + = forall arg. KindOf (Apply (:<<<%%%%%%%%%%:+$) arg) ~ KindOf ((:<<<%%%%%%%%%%:+$$) arg) => + (:<<<%%%%%%%%%%:+$###) + type instance Apply (:<<<%%%%%%%%%%:+$) l = (:<<<%%%%%%%%%%:+$$) l + type family (:<<<%%%%%%%%%%:+) x (a :: Nat) (a :: Nat) :: Nat where + (:<<<%%%%%%%%%%:+) x Zero m = m + (:<<<%%%%%%%%%%:+) x (Succ n) m = Apply SuccSym0 (Apply (Apply ((:<<<%%%%%%%%%%:+$$) x) n) x) + type Let0123456789ZSym1 t = Let0123456789Z t + instance SuppressUnusedWarnings Let0123456789ZSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Let0123456789ZSym0KindInference GHC.Tuple.()) + data Let0123456789ZSym0 l + = forall arg. KindOf (Apply Let0123456789ZSym0 arg) ~ KindOf (Let0123456789ZSym1 arg) => + Let0123456789ZSym0KindInference + type instance Apply Let0123456789ZSym0 l = Let0123456789ZSym1 l + type (:<<<%%%%%%%%%%:+$$$$) t (t :: Nat) (t :: Nat) = + (:<<<%%%%%%%%%%:+) t t t + instance SuppressUnusedWarnings (:<<<%%%%%%%%%%:+$$$) where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) (:<<<%%%%%%%%%%:+$$$###) GHC.Tuple.()) + data (:<<<%%%%%%%%%%:+$$$) l (l :: Nat) (l :: TyFun Nat Nat) + = forall arg. KindOf (Apply ((:<<<%%%%%%%%%%:+$$$) l l) arg) ~ KindOf ((:<<<%%%%%%%%%%:+$$$$) l l arg) => + (:<<<%%%%%%%%%%:+$$$###) + type instance Apply ((:<<<%%%%%%%%%%:+$$$) l l) l = (:<<<%%%%%%%%%%:+$$$$) l l l + instance SuppressUnusedWarnings (:<<<%%%%%%%%%%:+$$) where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) (:<<<%%%%%%%%%%:+$$###) GHC.Tuple.()) + data (:<<<%%%%%%%%%%:+$$) l + (l :: TyFun Nat (TyFun Nat Nat -> GHC.Types.Type)) + = forall arg. KindOf (Apply ((:<<<%%%%%%%%%%:+$$) l) arg) ~ KindOf ((:<<<%%%%%%%%%%:+$$$) l arg) => + (:<<<%%%%%%%%%%:+$$###) + type instance Apply ((:<<<%%%%%%%%%%:+$$) l) l = (:<<<%%%%%%%%%%:+$$$) l l + instance SuppressUnusedWarnings (:<<<%%%%%%%%%%:+$) where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) (:<<<%%%%%%%%%%:+$###) GHC.Tuple.()) + data (:<<<%%%%%%%%%%:+$) l + = forall arg. KindOf (Apply (:<<<%%%%%%%%%%:+$) arg) ~ KindOf ((:<<<%%%%%%%%%%:+$$) arg) => + (:<<<%%%%%%%%%%:+$###) + type instance Apply (:<<<%%%%%%%%%%:+$) l = (:<<<%%%%%%%%%%:+$$) l + type family Let0123456789Z x :: Nat where + Let0123456789Z x = x + type family (:<<<%%%%%%%%%%:+) x (a :: Nat) (a :: Nat) :: Nat where + (:<<<%%%%%%%%%%:+) x Zero m = m + (:<<<%%%%%%%%%%:+) x (Succ n) m = Apply SuccSym0 (Apply (Apply ((:<<<%%%%%%%%%%:+$$) x) n) m) + type (:<<<%%%%%%%%%%:+$$$$) t (t :: Nat) (t :: Nat) = + (:<<<%%%%%%%%%%:+) t t t + instance SuppressUnusedWarnings (:<<<%%%%%%%%%%:+$$$) where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) (:<<<%%%%%%%%%%:+$$$###) GHC.Tuple.()) + data (:<<<%%%%%%%%%%:+$$$) l (l :: Nat) (l :: TyFun Nat Nat) + = forall arg. KindOf (Apply ((:<<<%%%%%%%%%%:+$$$) l l) arg) ~ KindOf ((:<<<%%%%%%%%%%:+$$$$) l l arg) => + (:<<<%%%%%%%%%%:+$$$###) + type instance Apply ((:<<<%%%%%%%%%%:+$$$) l l) l = (:<<<%%%%%%%%%%:+$$$$) l l l + instance SuppressUnusedWarnings (:<<<%%%%%%%%%%:+$$) where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) (:<<<%%%%%%%%%%:+$$###) GHC.Tuple.()) + data (:<<<%%%%%%%%%%:+$$) l + (l :: TyFun Nat (TyFun Nat Nat -> GHC.Types.Type)) + = forall arg. KindOf (Apply ((:<<<%%%%%%%%%%:+$$) l) arg) ~ KindOf ((:<<<%%%%%%%%%%:+$$$) l arg) => + (:<<<%%%%%%%%%%:+$$###) + type instance Apply ((:<<<%%%%%%%%%%:+$$) l) l = (:<<<%%%%%%%%%%:+$$$) l l + instance SuppressUnusedWarnings (:<<<%%%%%%%%%%:+$) where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) (:<<<%%%%%%%%%%:+$###) GHC.Tuple.()) + data (:<<<%%%%%%%%%%:+$) l + = forall arg. KindOf (Apply (:<<<%%%%%%%%%%:+$) arg) ~ KindOf ((:<<<%%%%%%%%%%:+$$) arg) => + (:<<<%%%%%%%%%%:+$###) + type instance Apply (:<<<%%%%%%%%%%:+$) l = (:<<<%%%%%%%%%%:+$$) l + 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_0123456789 x a_0123456789 t where + Lambda_0123456789 x a_0123456789 x = x + type Lambda_0123456789Sym3 t t t = Lambda_0123456789 t t t + instance SuppressUnusedWarnings Lambda_0123456789Sym2 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym2KindInference GHC.Tuple.()) + data Lambda_0123456789Sym2 l l l + = forall arg. KindOf (Apply (Lambda_0123456789Sym2 l l) arg) ~ KindOf (Lambda_0123456789Sym3 l l arg) => + Lambda_0123456789Sym2KindInference + type instance Apply (Lambda_0123456789Sym2 l l) l = Lambda_0123456789Sym3 l l l + instance SuppressUnusedWarnings Lambda_0123456789Sym1 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym1KindInference GHC.Tuple.()) + data Lambda_0123456789Sym1 l l + = forall arg. KindOf (Apply (Lambda_0123456789Sym1 l) arg) ~ KindOf (Lambda_0123456789Sym2 l arg) => + Lambda_0123456789Sym1KindInference + type instance Apply (Lambda_0123456789Sym1 l) l = Lambda_0123456789Sym2 l l + instance SuppressUnusedWarnings Lambda_0123456789Sym0 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym0KindInference GHC.Tuple.()) + data Lambda_0123456789Sym0 l + = forall arg. KindOf (Apply Lambda_0123456789Sym0 arg) ~ KindOf (Lambda_0123456789Sym1 arg) => + Lambda_0123456789Sym0KindInference + type instance Apply Lambda_0123456789Sym0 l = Lambda_0123456789Sym1 l + type Let0123456789ZSym2 t (t :: Nat) = Let0123456789Z t t + instance SuppressUnusedWarnings Let0123456789ZSym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Let0123456789ZSym1KindInference GHC.Tuple.()) + data Let0123456789ZSym1 l (l :: TyFun Nat Nat) + = forall arg. KindOf (Apply (Let0123456789ZSym1 l) arg) ~ KindOf (Let0123456789ZSym2 l arg) => + Let0123456789ZSym1KindInference + type instance Apply (Let0123456789ZSym1 l) l = Let0123456789ZSym2 l l + instance SuppressUnusedWarnings Let0123456789ZSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Let0123456789ZSym0KindInference GHC.Tuple.()) + data Let0123456789ZSym0 l + = forall arg. KindOf (Apply Let0123456789ZSym0 arg) ~ KindOf (Let0123456789ZSym1 arg) => + Let0123456789ZSym0KindInference + type instance Apply Let0123456789ZSym0 l = Let0123456789ZSym1 l + type family Let0123456789Z x (a :: Nat) :: Nat where + Let0123456789Z x a_0123456789 = Apply (Apply (Apply Lambda_0123456789Sym0 x) a_0123456789) a_0123456789 + type family Lambda_0123456789 x t where + Lambda_0123456789 x x = x + type Lambda_0123456789Sym2 t t = Lambda_0123456789 t t + instance SuppressUnusedWarnings Lambda_0123456789Sym1 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym1KindInference GHC.Tuple.()) + data Lambda_0123456789Sym1 l l + = forall arg. KindOf (Apply (Lambda_0123456789Sym1 l) arg) ~ KindOf (Lambda_0123456789Sym2 l arg) => + Lambda_0123456789Sym1KindInference + type instance Apply (Lambda_0123456789Sym1 l) l = Lambda_0123456789Sym2 l l + instance SuppressUnusedWarnings Lambda_0123456789Sym0 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym0KindInference GHC.Tuple.()) + data Lambda_0123456789Sym0 l + = forall arg. KindOf (Apply Lambda_0123456789Sym0 arg) ~ KindOf (Lambda_0123456789Sym1 arg) => + Lambda_0123456789Sym0KindInference + type instance Apply Lambda_0123456789Sym0 l = Lambda_0123456789Sym1 l + type Let0123456789ZSym1 t = Let0123456789Z t + instance SuppressUnusedWarnings Let0123456789ZSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Let0123456789ZSym0KindInference GHC.Tuple.()) + data Let0123456789ZSym0 l + = forall arg. KindOf (Apply Let0123456789ZSym0 arg) ~ KindOf (Let0123456789ZSym1 arg) => + Let0123456789ZSym0KindInference + type instance Apply Let0123456789ZSym0 l = Let0123456789ZSym1 l + type family Let0123456789Z x :: Nat where + Let0123456789Z x = Apply (Apply Lambda_0123456789Sym0 x) ZeroSym0 + type Let0123456789XSym1 t = Let0123456789X t + instance SuppressUnusedWarnings Let0123456789XSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Let0123456789XSym0KindInference GHC.Tuple.()) + data Let0123456789XSym0 l + = forall arg. KindOf (Apply Let0123456789XSym0 arg) ~ KindOf (Let0123456789XSym1 arg) => + Let0123456789XSym0KindInference + type instance Apply Let0123456789XSym0 l = Let0123456789XSym1 l + type family Let0123456789X x :: Nat where + Let0123456789X x = ZeroSym0 + type Let0123456789FSym2 t (t :: Nat) = Let0123456789F t t + instance SuppressUnusedWarnings Let0123456789FSym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Let0123456789FSym1KindInference GHC.Tuple.()) + data Let0123456789FSym1 l (l :: TyFun Nat Nat) + = forall arg. KindOf (Apply (Let0123456789FSym1 l) arg) ~ KindOf (Let0123456789FSym2 l arg) => + Let0123456789FSym1KindInference + type instance Apply (Let0123456789FSym1 l) l = Let0123456789FSym2 l l + instance SuppressUnusedWarnings Let0123456789FSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Let0123456789FSym0KindInference GHC.Tuple.()) + data Let0123456789FSym0 l + = forall arg. KindOf (Apply Let0123456789FSym0 arg) ~ KindOf (Let0123456789FSym1 arg) => + Let0123456789FSym0KindInference + type instance Apply Let0123456789FSym0 l = Let0123456789FSym1 l + type family Let0123456789F x (a :: Nat) :: Nat where + Let0123456789F x y = Apply SuccSym0 y + type Let0123456789ZSym1 t = Let0123456789Z t + instance SuppressUnusedWarnings Let0123456789ZSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Let0123456789ZSym0KindInference GHC.Tuple.()) + data Let0123456789ZSym0 l + = forall arg. KindOf (Apply Let0123456789ZSym0 arg) ~ KindOf (Let0123456789ZSym1 arg) => + Let0123456789ZSym0KindInference + type instance Apply Let0123456789ZSym0 l = Let0123456789ZSym1 l + type family Let0123456789Z x :: Nat where + Let0123456789Z x = Apply (Let0123456789FSym1 x) x + type Let0123456789ZSym2 t t = Let0123456789Z t t + instance SuppressUnusedWarnings Let0123456789ZSym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Let0123456789ZSym1KindInference GHC.Tuple.()) + data Let0123456789ZSym1 l l + = forall arg. KindOf (Apply (Let0123456789ZSym1 l) arg) ~ KindOf (Let0123456789ZSym2 l arg) => + Let0123456789ZSym1KindInference + type instance Apply (Let0123456789ZSym1 l) l = Let0123456789ZSym2 l l + instance SuppressUnusedWarnings Let0123456789ZSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Let0123456789ZSym0KindInference GHC.Tuple.()) + data Let0123456789ZSym0 l + = forall arg. KindOf (Apply Let0123456789ZSym0 arg) ~ KindOf (Let0123456789ZSym1 arg) => + Let0123456789ZSym0KindInference + type instance Apply Let0123456789ZSym0 l = Let0123456789ZSym1 l + type family Let0123456789Z x y :: Nat where + Let0123456789Z x y = Apply SuccSym0 y + type Let0123456789FSym2 t (t :: Nat) = Let0123456789F t t + instance SuppressUnusedWarnings Let0123456789FSym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Let0123456789FSym1KindInference GHC.Tuple.()) + data Let0123456789FSym1 l (l :: TyFun Nat Nat) + = forall arg. KindOf (Apply (Let0123456789FSym1 l) arg) ~ KindOf (Let0123456789FSym2 l arg) => + Let0123456789FSym1KindInference + type instance Apply (Let0123456789FSym1 l) l = Let0123456789FSym2 l l + instance SuppressUnusedWarnings Let0123456789FSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Let0123456789FSym0KindInference GHC.Tuple.()) + data Let0123456789FSym0 l + = forall arg. KindOf (Apply Let0123456789FSym0 arg) ~ KindOf (Let0123456789FSym1 arg) => + Let0123456789FSym0KindInference + type instance Apply Let0123456789FSym0 l = Let0123456789FSym1 l + type family Let0123456789F x (a :: Nat) :: Nat where + Let0123456789F x y = Apply SuccSym0 (Let0123456789ZSym2 x y) + type Let0123456789FSym2 t (t :: Nat) = Let0123456789F t t + instance SuppressUnusedWarnings Let0123456789FSym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Let0123456789FSym1KindInference GHC.Tuple.()) + data Let0123456789FSym1 l (l :: TyFun Nat Nat) + = forall arg. KindOf (Apply (Let0123456789FSym1 l) arg) ~ KindOf (Let0123456789FSym2 l arg) => + Let0123456789FSym1KindInference + type instance Apply (Let0123456789FSym1 l) l = Let0123456789FSym2 l l + instance SuppressUnusedWarnings Let0123456789FSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Let0123456789FSym0KindInference GHC.Tuple.()) + data Let0123456789FSym0 l + = forall arg. KindOf (Apply Let0123456789FSym0 arg) ~ KindOf (Let0123456789FSym1 arg) => + Let0123456789FSym0KindInference + type instance Apply Let0123456789FSym0 l = Let0123456789FSym1 l + type family Let0123456789F x (a :: Nat) :: Nat where + Let0123456789F x y = Apply SuccSym0 y + type Let0123456789YSym1 t = Let0123456789Y t + instance SuppressUnusedWarnings Let0123456789YSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Let0123456789YSym0KindInference GHC.Tuple.()) + data Let0123456789YSym0 l + = forall arg. KindOf (Apply Let0123456789YSym0 arg) ~ KindOf (Let0123456789YSym1 arg) => + Let0123456789YSym0KindInference + type instance Apply Let0123456789YSym0 l = Let0123456789YSym1 l + type family Let0123456789Y x :: Nat where + Let0123456789Y x = Apply SuccSym0 x + type Let0123456789YSym0 = Let0123456789Y + type Let0123456789ZSym0 = Let0123456789Z + type family Let0123456789Y where + Let0123456789Y = Apply SuccSym0 ZeroSym0 + type family Let0123456789Z where + Let0123456789Z = Apply SuccSym0 Let0123456789YSym0 + type Let0123456789YSym1 t = Let0123456789Y t + instance SuppressUnusedWarnings Let0123456789YSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Let0123456789YSym0KindInference GHC.Tuple.()) + data Let0123456789YSym0 l + = forall arg. KindOf (Apply Let0123456789YSym0 arg) ~ KindOf (Let0123456789YSym1 arg) => + Let0123456789YSym0KindInference + type instance Apply Let0123456789YSym0 l = Let0123456789YSym1 l + type family Let0123456789Y x :: Nat where + Let0123456789Y x = Apply SuccSym0 ZeroSym0 + type Foo14Sym1 (t :: Nat) = Foo14 t + instance SuppressUnusedWarnings Foo14Sym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Foo14Sym0KindInference GHC.Tuple.()) + data Foo14Sym0 (l :: TyFun Nat (Nat, Nat)) + = forall arg. KindOf (Apply Foo14Sym0 arg) ~ KindOf (Foo14Sym1 arg) => + Foo14Sym0KindInference + type instance Apply Foo14Sym0 l = Foo14Sym1 l + type Foo13_Sym1 (t :: a0123456789) = Foo13_ t + instance SuppressUnusedWarnings Foo13_Sym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Foo13_Sym0KindInference GHC.Tuple.()) + data Foo13_Sym0 (l :: TyFun a0123456789 a0123456789) + = forall arg. KindOf (Apply Foo13_Sym0 arg) ~ KindOf (Foo13_Sym1 arg) => + Foo13_Sym0KindInference + type instance Apply Foo13_Sym0 l = Foo13_Sym1 l + type Foo13Sym1 (t :: a0123456789) = Foo13 t + instance SuppressUnusedWarnings Foo13Sym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Foo13Sym0KindInference GHC.Tuple.()) + data Foo13Sym0 (l :: TyFun a0123456789 a0123456789) + = forall arg. KindOf (Apply Foo13Sym0 arg) ~ KindOf (Foo13Sym1 arg) => + Foo13Sym0KindInference + type instance Apply Foo13Sym0 l = Foo13Sym1 l + type Foo12Sym1 (t :: Nat) = Foo12 t + instance SuppressUnusedWarnings Foo12Sym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Foo12Sym0KindInference GHC.Tuple.()) + data Foo12Sym0 (l :: TyFun Nat Nat) + = forall arg. KindOf (Apply Foo12Sym0 arg) ~ KindOf (Foo12Sym1 arg) => + Foo12Sym0KindInference + type instance Apply Foo12Sym0 l = Foo12Sym1 l + type Foo11Sym1 (t :: Nat) = Foo11 t + instance SuppressUnusedWarnings Foo11Sym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Foo11Sym0KindInference GHC.Tuple.()) + data Foo11Sym0 (l :: TyFun Nat Nat) + = forall arg. KindOf (Apply Foo11Sym0 arg) ~ KindOf (Foo11Sym1 arg) => + Foo11Sym0KindInference + type instance Apply Foo11Sym0 l = Foo11Sym1 l + type Foo10Sym1 (t :: Nat) = Foo10 t + instance SuppressUnusedWarnings Foo10Sym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Foo10Sym0KindInference GHC.Tuple.()) + data Foo10Sym0 (l :: TyFun Nat Nat) + = forall arg. KindOf (Apply Foo10Sym0 arg) ~ KindOf (Foo10Sym1 arg) => + Foo10Sym0KindInference + type instance Apply Foo10Sym0 l = Foo10Sym1 l + type Foo9Sym1 (t :: Nat) = Foo9 t + instance SuppressUnusedWarnings Foo9Sym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Foo9Sym0KindInference GHC.Tuple.()) + data Foo9Sym0 (l :: TyFun Nat Nat) + = forall arg. KindOf (Apply Foo9Sym0 arg) ~ KindOf (Foo9Sym1 arg) => + Foo9Sym0KindInference + type instance Apply Foo9Sym0 l = Foo9Sym1 l + type Foo8Sym1 (t :: Nat) = Foo8 t + instance SuppressUnusedWarnings Foo8Sym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Foo8Sym0KindInference GHC.Tuple.()) + data Foo8Sym0 (l :: TyFun Nat Nat) + = forall arg. KindOf (Apply Foo8Sym0 arg) ~ KindOf (Foo8Sym1 arg) => + Foo8Sym0KindInference + type instance Apply Foo8Sym0 l = Foo8Sym1 l + type Foo7Sym1 (t :: Nat) = Foo7 t + instance SuppressUnusedWarnings Foo7Sym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Foo7Sym0KindInference GHC.Tuple.()) + data Foo7Sym0 (l :: TyFun Nat Nat) + = forall arg. KindOf (Apply Foo7Sym0 arg) ~ KindOf (Foo7Sym1 arg) => + Foo7Sym0KindInference + type instance Apply Foo7Sym0 l = Foo7Sym1 l + type Foo6Sym1 (t :: Nat) = Foo6 t + instance SuppressUnusedWarnings Foo6Sym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Foo6Sym0KindInference GHC.Tuple.()) + data Foo6Sym0 (l :: TyFun Nat Nat) + = forall arg. KindOf (Apply Foo6Sym0 arg) ~ KindOf (Foo6Sym1 arg) => + Foo6Sym0KindInference + type instance Apply Foo6Sym0 l = Foo6Sym1 l + type Foo5Sym1 (t :: Nat) = Foo5 t + instance SuppressUnusedWarnings Foo5Sym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Foo5Sym0KindInference GHC.Tuple.()) + data Foo5Sym0 (l :: TyFun Nat Nat) + = forall arg. KindOf (Apply Foo5Sym0 arg) ~ KindOf (Foo5Sym1 arg) => + Foo5Sym0KindInference + type instance Apply Foo5Sym0 l = Foo5Sym1 l + type Foo4Sym1 (t :: Nat) = Foo4 t + instance SuppressUnusedWarnings Foo4Sym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Foo4Sym0KindInference GHC.Tuple.()) + data Foo4Sym0 (l :: TyFun Nat Nat) + = forall arg. KindOf (Apply Foo4Sym0 arg) ~ KindOf (Foo4Sym1 arg) => + Foo4Sym0KindInference + type instance Apply Foo4Sym0 l = Foo4Sym1 l + type Foo3Sym1 (t :: Nat) = Foo3 t + instance SuppressUnusedWarnings Foo3Sym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Foo3Sym0KindInference GHC.Tuple.()) + data Foo3Sym0 (l :: TyFun Nat Nat) + = forall arg. KindOf (Apply Foo3Sym0 arg) ~ KindOf (Foo3Sym1 arg) => + Foo3Sym0KindInference + type instance Apply Foo3Sym0 l = Foo3Sym1 l + type Foo2Sym0 = Foo2 + type Foo1Sym1 (t :: Nat) = Foo1 t + instance SuppressUnusedWarnings Foo1Sym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Foo1Sym0KindInference GHC.Tuple.()) + data Foo1Sym0 (l :: TyFun Nat Nat) + = forall arg. KindOf (Apply Foo1Sym0 arg) ~ KindOf (Foo1Sym1 arg) => + Foo1Sym0KindInference + type instance Apply Foo1Sym0 l = Foo1Sym1 l + type family Foo14 (a :: Nat) :: (Nat, Nat) where + Foo14 x = Apply (Apply Tuple2Sym0 (Let0123456789ZSym1 x)) (Let0123456789YSym1 x) + type family Foo13_ (a :: a) :: a where + Foo13_ y = y + type family Foo13 (a :: a) :: a where + Foo13 x = Apply Foo13_Sym0 (Let0123456789BarSym1 x) + type family Foo12 (a :: Nat) :: Nat where + Foo12 x = Apply (Apply ((:<<<%%%%%%%%%%:+$$) x) x) (Apply SuccSym0 (Apply SuccSym0 ZeroSym0)) + type family Foo11 (a :: Nat) :: Nat where + Foo11 x = Apply (Apply ((:<<<%%%%%%%%%%:+$$) x) (Apply SuccSym0 ZeroSym0)) (Let0123456789ZSym1 x) + type family Foo10 (a :: Nat) :: Nat where + Foo10 x = Apply (Apply ((:<<<%%%%%%%%%%:+$$) x) (Apply SuccSym0 ZeroSym0)) x + type family Foo9 (a :: Nat) :: Nat where + Foo9 x = Apply (Let0123456789ZSym1 x) x + type family Foo8 (a :: Nat) :: Nat where + Foo8 x = Let0123456789ZSym1 x + type family Foo7 (a :: Nat) :: Nat where + Foo7 x = Let0123456789XSym1 x + type family Foo6 (a :: Nat) :: Nat where + Foo6 x = Let0123456789ZSym1 x + type family Foo5 (a :: Nat) :: Nat where + Foo5 x = Apply (Let0123456789FSym1 x) x + type family Foo4 (a :: Nat) :: Nat where + Foo4 x = Apply (Let0123456789FSym1 x) x + type family Foo3 (a :: Nat) :: Nat where + Foo3 x = Let0123456789YSym1 x + type family Foo2 :: Nat where + Foo2 = Let0123456789ZSym0 + type family Foo1 (a :: Nat) :: Nat where + Foo1 x = Let0123456789YSym1 x + sFoo14 :: + forall (t :: Nat). Sing t -> Sing (Apply Foo14Sym0 t :: (Nat, Nat)) + sFoo13_ :: + forall (t :: a). Sing t -> Sing (Apply Foo13_Sym0 t :: a) + sFoo13 :: forall (t :: a). Sing t -> Sing (Apply Foo13Sym0 t :: a) + sFoo12 :: + forall (t :: Nat). Sing t -> Sing (Apply Foo12Sym0 t :: Nat) + sFoo11 :: + forall (t :: Nat). Sing t -> Sing (Apply Foo11Sym0 t :: Nat) + sFoo10 :: + forall (t :: Nat). Sing t -> Sing (Apply Foo10Sym0 t :: Nat) + sFoo9 :: + forall (t :: Nat). Sing t -> Sing (Apply Foo9Sym0 t :: Nat) + sFoo8 :: + forall (t :: Nat). Sing t -> Sing (Apply Foo8Sym0 t :: Nat) + sFoo7 :: + forall (t :: Nat). Sing t -> Sing (Apply Foo7Sym0 t :: Nat) + sFoo6 :: + forall (t :: Nat). Sing t -> Sing (Apply Foo6Sym0 t :: Nat) + sFoo5 :: + forall (t :: Nat). Sing t -> Sing (Apply Foo5Sym0 t :: Nat) + sFoo4 :: + forall (t :: Nat). Sing t -> Sing (Apply Foo4Sym0 t :: Nat) + sFoo3 :: + forall (t :: Nat). Sing t -> Sing (Apply Foo3Sym0 t :: Nat) + sFoo2 :: Sing (Foo2Sym0 :: Nat) + sFoo1 :: + forall (t :: Nat). Sing t -> Sing (Apply Foo1Sym0 t :: Nat) + sFoo14 sX + = let + lambda :: + forall x. t ~ x => Sing x -> Sing (Apply Foo14Sym0 t :: (Nat, Nat)) + lambda x + = let + sY :: Sing (Let0123456789YSym1 x) + sZ :: Sing (Let0123456789ZSym1 x) + sX_0123456789 :: Sing (Let0123456789X_0123456789Sym1 x) + sY + = case sX_0123456789 of { + STuple2 sY_0123456789 _s_z_0123456789 + -> let + lambda :: + forall y_0123456789 _z_0123456789. + Apply (Apply Tuple2Sym0 y_0123456789) _z_0123456789 ~ Let0123456789X_0123456789Sym1 x => + Sing y_0123456789 + -> Sing _z_0123456789 + -> Sing (Case_0123456789 x (Apply (Apply Tuple2Sym0 y_0123456789) _z_0123456789)) + lambda y_0123456789 _z_0123456789 = y_0123456789 + in lambda sY_0123456789 _s_z_0123456789 } :: + Sing (Case_0123456789 x (Let0123456789X_0123456789Sym1 x)) + sZ + = case sX_0123456789 of { + STuple2 _s_z_0123456789 sY_0123456789 + -> let + lambda :: + forall _z_0123456789 y_0123456789. + Apply (Apply Tuple2Sym0 _z_0123456789) y_0123456789 ~ Let0123456789X_0123456789Sym1 x => + Sing _z_0123456789 + -> Sing y_0123456789 + -> Sing (Case_0123456789 x (Apply (Apply Tuple2Sym0 _z_0123456789) y_0123456789)) + lambda _z_0123456789 y_0123456789 = y_0123456789 + in lambda _s_z_0123456789 sY_0123456789 } :: + Sing (Case_0123456789 x (Let0123456789X_0123456789Sym1 x)) + sX_0123456789 + = applySing + (applySing + (singFun2 (Proxy :: Proxy Tuple2Sym0) STuple2) + (applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) x)) + x + in + applySing + (applySing (singFun2 (Proxy :: Proxy Tuple2Sym0) STuple2) sZ) sY + in lambda sX + sFoo13_ sY + = let + lambda :: + forall y. t ~ y => Sing y -> Sing (Apply Foo13_Sym0 t :: a) + lambda y = y + in lambda sY + sFoo13 sX + = let + lambda :: + forall x. t ~ x => Sing x -> Sing (Apply Foo13Sym0 t :: a) + lambda x + = let + sBar :: Sing (Let0123456789BarSym1 x :: a) + sBar = x + in applySing (singFun1 (Proxy :: Proxy Foo13_Sym0) sFoo13_) sBar + in lambda sX + sFoo12 sX + = let + lambda :: + forall x. t ~ x => Sing x -> Sing (Apply Foo12Sym0 t :: Nat) + lambda x + = let + (%:+) :: + forall (t :: Nat) (t :: Nat). + Sing t + -> Sing t + -> Sing (Apply (Apply ((:<<<%%%%%%%%%%:+$$) x) t) t :: Nat) + (%:+) SZero sM + = let + lambda :: + forall m. + (t ~ ZeroSym0, t ~ m) => + Sing m -> Sing (Apply (Apply ((:<<<%%%%%%%%%%:+$$) x) t) t :: Nat) + lambda m = m + in lambda sM + (%:+) (SSucc sN) sM + = let + lambda :: + forall n m. + (t ~ Apply SuccSym0 n, t ~ m) => + Sing n + -> Sing m + -> Sing (Apply (Apply ((:<<<%%%%%%%%%%:+$$) x) t) t :: Nat) + lambda n m + = applySing + (singFun1 (Proxy :: Proxy SuccSym0) SSucc) + (applySing + (applySing + (singFun2 (Proxy :: Proxy ((:<<<%%%%%%%%%%:+$$) x)) (%:+)) n) + x) + in lambda sN sM + in + applySing + (applySing + (singFun2 (Proxy :: Proxy ((:<<<%%%%%%%%%%:+$$) x)) (%:+)) x) + (applySing + (singFun1 (Proxy :: Proxy SuccSym0) SSucc) + (applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) SZero)) + in lambda sX + sFoo11 sX + = let + lambda :: + forall x. t ~ x => Sing x -> Sing (Apply Foo11Sym0 t :: Nat) + lambda x + = let + sZ :: Sing (Let0123456789ZSym1 x :: Nat) + (%:+) :: + forall (t :: Nat) (t :: Nat). + Sing t + -> Sing t + -> Sing (Apply (Apply ((:<<<%%%%%%%%%%:+$$) x) t) t :: Nat) + sZ = x + (%:+) SZero sM + = let + lambda :: + forall m. + (t ~ ZeroSym0, t ~ m) => + Sing m -> Sing (Apply (Apply ((:<<<%%%%%%%%%%:+$$) x) t) t :: Nat) + lambda m = m + in lambda sM + (%:+) (SSucc sN) sM + = let + lambda :: + forall n m. + (t ~ Apply SuccSym0 n, t ~ m) => + Sing n + -> Sing m + -> Sing (Apply (Apply ((:<<<%%%%%%%%%%:+$$) x) t) t :: Nat) + lambda n m + = applySing + (singFun1 (Proxy :: Proxy SuccSym0) SSucc) + (applySing + (applySing + (singFun2 (Proxy :: Proxy ((:<<<%%%%%%%%%%:+$$) x)) (%:+)) n) + m) + in lambda sN sM + in + applySing + (applySing + (singFun2 (Proxy :: Proxy ((:<<<%%%%%%%%%%:+$$) x)) (%:+)) + (applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) SZero)) + sZ + in lambda sX + sFoo10 sX + = let + lambda :: + forall x. t ~ x => Sing x -> Sing (Apply Foo10Sym0 t :: Nat) + lambda x + = let + (%:+) :: + forall (t :: Nat) (t :: Nat). + Sing t + -> Sing t + -> Sing (Apply (Apply ((:<<<%%%%%%%%%%:+$$) x) t) t :: Nat) + (%:+) SZero sM + = let + lambda :: + forall m. + (t ~ ZeroSym0, t ~ m) => + Sing m -> Sing (Apply (Apply ((:<<<%%%%%%%%%%:+$$) x) t) t :: Nat) + lambda m = m + in lambda sM + (%:+) (SSucc sN) sM + = let + lambda :: + forall n m. + (t ~ Apply SuccSym0 n, t ~ m) => + Sing n + -> Sing m + -> Sing (Apply (Apply ((:<<<%%%%%%%%%%:+$$) x) t) t :: Nat) + lambda n m + = applySing + (singFun1 (Proxy :: Proxy SuccSym0) SSucc) + (applySing + (applySing + (singFun2 (Proxy :: Proxy ((:<<<%%%%%%%%%%:+$$) x)) (%:+)) n) + m) + in lambda sN sM + in + applySing + (applySing + (singFun2 (Proxy :: Proxy ((:<<<%%%%%%%%%%:+$$) x)) (%:+)) + (applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) SZero)) + x + in lambda sX + sFoo9 sX + = let + lambda :: + forall x. t ~ x => Sing x -> Sing (Apply Foo9Sym0 t :: Nat) + lambda x + = let + sZ :: + forall (t :: Nat). + Sing t -> Sing (Apply (Let0123456789ZSym1 x) t :: Nat) + sZ sA_0123456789 + = let + lambda :: + forall a_0123456789. + t ~ a_0123456789 => + Sing a_0123456789 -> Sing (Apply (Let0123456789ZSym1 x) t :: Nat) + lambda a_0123456789 + = applySing + (singFun1 + (Proxy :: + Proxy (Apply (Apply Lambda_0123456789Sym0 x) a_0123456789)) + (\ sX + -> let + lambda :: + forall x. + Sing x + -> Sing (Apply (Apply (Apply Lambda_0123456789Sym0 x) a_0123456789) x) + lambda x = x + in lambda sX)) + a_0123456789 + in lambda sA_0123456789 + in + applySing (singFun1 (Proxy :: Proxy (Let0123456789ZSym1 x)) sZ) x + in lambda sX + sFoo8 sX + = let + lambda :: + forall x. t ~ x => Sing x -> Sing (Apply Foo8Sym0 t :: Nat) + lambda x + = let + sZ :: Sing (Let0123456789ZSym1 x :: Nat) + sZ + = applySing + (singFun1 + (Proxy :: Proxy (Apply Lambda_0123456789Sym0 x)) + (\ sX + -> let + lambda :: + forall x. + Sing x -> Sing (Apply (Apply Lambda_0123456789Sym0 x) x) + lambda x = x + in lambda sX)) + SZero + in sZ + in lambda sX + sFoo7 sX + = let + lambda :: + forall x. t ~ x => Sing x -> Sing (Apply Foo7Sym0 t :: Nat) + lambda x + = let + sX :: Sing (Let0123456789XSym1 x :: Nat) + sX = SZero + in sX + in lambda sX + sFoo6 sX + = let + lambda :: + forall x. t ~ x => Sing x -> Sing (Apply Foo6Sym0 t :: Nat) + lambda x + = let + sF :: + forall (t :: Nat). + Sing t -> Sing (Apply (Let0123456789FSym1 x) t :: Nat) + sF sY + = let + lambda :: + forall y. + t ~ y => Sing y -> Sing (Apply (Let0123456789FSym1 x) t :: Nat) + lambda y = applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) y + in lambda sY in + let + sZ :: Sing (Let0123456789ZSym1 x :: Nat) + sZ + = applySing (singFun1 (Proxy :: Proxy (Let0123456789FSym1 x)) sF) x + in sZ + in lambda sX + sFoo5 sX + = let + lambda :: + forall x. t ~ x => Sing x -> Sing (Apply Foo5Sym0 t :: Nat) + lambda x + = let + sF :: + forall (t :: Nat). + Sing t -> Sing (Apply (Let0123456789FSym1 x) t :: Nat) + sF sY + = let + lambda :: + forall y. + t ~ y => Sing y -> Sing (Apply (Let0123456789FSym1 x) t :: Nat) + lambda y + = let + sZ :: Sing (Let0123456789ZSym2 x y :: Nat) + sZ = applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) y + in applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) sZ + in lambda sY + in + applySing (singFun1 (Proxy :: Proxy (Let0123456789FSym1 x)) sF) x + in lambda sX + sFoo4 sX + = let + lambda :: + forall x. t ~ x => Sing x -> Sing (Apply Foo4Sym0 t :: Nat) + lambda x + = let + sF :: + forall (t :: Nat). + Sing t -> Sing (Apply (Let0123456789FSym1 x) t :: Nat) + sF sY + = let + lambda :: + forall y. + t ~ y => Sing y -> Sing (Apply (Let0123456789FSym1 x) t :: Nat) + lambda y = applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) y + in lambda sY + in + applySing (singFun1 (Proxy :: Proxy (Let0123456789FSym1 x)) sF) x + in lambda sX + sFoo3 sX + = let + lambda :: + forall x. t ~ x => Sing x -> Sing (Apply Foo3Sym0 t :: Nat) + lambda x + = let + sY :: Sing (Let0123456789YSym1 x :: Nat) + sY = applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) x + in sY + in lambda sX + sFoo2 + = let + sY :: Sing Let0123456789YSym0 + sZ :: Sing Let0123456789ZSym0 + sY = applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) SZero + sZ = applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) sY + in sZ + sFoo1 sX + = let + lambda :: + forall x. t ~ x => Sing x -> Sing (Apply Foo1Sym0 t :: Nat) + lambda x + = let + sY :: Sing (Let0123456789YSym1 x :: Nat) + sY = applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) SZero + in sY + in lambda sX diff --git a/tests/compile-and-dump/Singletons/Maybe.ghc710.template b/tests/compile-and-dump/Singletons/Maybe.ghc710.template --- a/tests/compile-and-dump/Singletons/Maybe.ghc710.template +++ b/tests/compile-and-dump/Singletons/Maybe.ghc710.template @@ -15,11 +15,11 @@ instance PEq (KProxy :: KProxy (Maybe k)) where type (:==) (a :: Maybe k) (b :: Maybe k) = Equals_0123456789 a b type NothingSym0 = Nothing - type JustSym1 (t :: a) = Just t + type JustSym1 (t :: a0123456789) = Just t instance SuppressUnusedWarnings JustSym0 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) JustSym0KindInference GHC.Tuple.()) - data JustSym0 (l :: TyFun a (Maybe a)) + data JustSym0 (l :: TyFun a0123456789 (Maybe a0123456789)) = forall arg. KindOf (Apply JustSym0 arg) ~ KindOf (JustSym1 arg) => JustSym0KindInference type instance Apply JustSym0 l = JustSym1 l diff --git a/tests/compile-and-dump/Singletons/Maybe.ghc80.template b/tests/compile-and-dump/Singletons/Maybe.ghc80.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/Maybe.ghc80.template @@ -0,0 +1,66 @@ +Singletons/Maybe.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| data Maybe a + = Nothing | Just a + deriving (Eq, Show) |] + ======> + data Maybe a + = Nothing | Just a + deriving (Eq, Show) + type family Equals_0123456789 (a :: Maybe k) + (b :: Maybe k) :: Bool where + Equals_0123456789 Nothing Nothing = TrueSym0 + Equals_0123456789 (Just a) (Just b) = (:==) a b + Equals_0123456789 (a :: Maybe k) (b :: Maybe k) = FalseSym0 + instance PEq (KProxy :: KProxy (Maybe k)) where + type (:==) (a :: Maybe k) (b :: Maybe k) = Equals_0123456789 a b + type NothingSym0 = Nothing + type JustSym1 (t :: a0123456789) = Just t + instance SuppressUnusedWarnings JustSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) JustSym0KindInference GHC.Tuple.()) + data JustSym0 (l :: TyFun a0123456789 (Maybe a0123456789)) + = forall arg. KindOf (Apply JustSym0 arg) ~ KindOf (JustSym1 arg) => + JustSym0KindInference + type instance Apply JustSym0 l = JustSym1 l + data instance Sing (z :: Maybe a) + = z ~ Nothing => SNothing | + forall (n :: a). z ~ Just n => SJust (Sing (n :: a)) + type SMaybe = (Sing :: Maybe a -> GHC.Types.Type) + instance SingKind (KProxy :: KProxy a) => + SingKind (KProxy :: KProxy (Maybe a)) where + type DemoteRep (KProxy :: KProxy (Maybe a)) = Maybe (DemoteRep (KProxy :: KProxy a)) + fromSing SNothing = Nothing + fromSing (SJust b) = Just (fromSing b) + toSing Nothing = SomeSing SNothing + toSing (Just b) + = case toSing b :: SomeSing (KProxy :: KProxy a) of { + SomeSing c -> SomeSing (SJust c) } + instance SEq (KProxy :: KProxy a) => + SEq (KProxy :: KProxy (Maybe a)) where + (%:==) SNothing SNothing = STrue + (%:==) SNothing (SJust _) = SFalse + (%:==) (SJust _) SNothing = SFalse + (%:==) (SJust a) (SJust b) = (%:==) a b + instance SDecide (KProxy :: KProxy a) => + SDecide (KProxy :: KProxy (Maybe a)) where + (%~) SNothing SNothing = Proved Refl + (%~) SNothing (SJust _) + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) (SJust _) SNothing + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) (SJust a) (SJust b) + = case (%~) a b of { + Proved Refl -> Proved Refl + Disproved contra + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) } + instance SingI Nothing where + sing = SNothing + instance SingI n => SingI (Just (n :: a)) where + sing = SJust sing diff --git a/tests/compile-and-dump/Singletons/Nat.ghc710.template b/tests/compile-and-dump/Singletons/Nat.ghc710.template --- a/tests/compile-and-dump/Singletons/Nat.ghc710.template +++ b/tests/compile-and-dump/Singletons/Nat.ghc710.template @@ -73,30 +73,28 @@ Sing t -> Sing t -> Sing (Apply (Apply PlusSym0 t) t :: Nat) sPred SZero = let - lambda :: t ~ ZeroSym0 => Sing (Apply PredSym0 ZeroSym0 :: Nat) + lambda :: t ~ ZeroSym0 => Sing (Apply PredSym0 t :: Nat) lambda = SZero in lambda sPred (SSucc sN) = let lambda :: forall n. t ~ Apply SuccSym0 n => - Sing n -> Sing (Apply PredSym0 (Apply SuccSym0 n) :: Nat) + Sing n -> Sing (Apply PredSym0 t :: Nat) lambda n = n in lambda sN sPlus SZero sM = let lambda :: forall m. (t ~ ZeroSym0, t ~ m) => - Sing m -> Sing (Apply (Apply PlusSym0 ZeroSym0) m :: Nat) + Sing m -> Sing (Apply (Apply PlusSym0 t) t :: Nat) lambda m = m in lambda sM sPlus (SSucc sN) sM = let lambda :: forall n m. (t ~ Apply SuccSym0 n, t ~ m) => - Sing n - -> Sing m - -> Sing (Apply (Apply PlusSym0 (Apply SuccSym0 n)) m :: Nat) + Sing n -> Sing m -> Sing (Apply (Apply PlusSym0 t) t :: Nat) lambda n m = applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) diff --git a/tests/compile-and-dump/Singletons/Nat.ghc80.template b/tests/compile-and-dump/Singletons/Nat.ghc80.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/Nat.ghc80.template @@ -0,0 +1,145 @@ +Singletons/Nat.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| plus :: Nat -> Nat -> Nat + plus Zero m = m + plus (Succ n) m = Succ (plus n m) + pred :: Nat -> Nat + pred Zero = Zero + pred (Succ n) = n + + data Nat + where + Zero :: Nat + Succ :: Nat -> Nat + deriving (Eq, Show, Read) |] + ======> + data Nat + where + Zero :: Nat + Succ :: Nat -> Nat + deriving (Eq, Show, Read) + plus :: Nat -> Nat -> Nat + plus Zero m = m + plus (Succ n) m = Succ (plus n m) + pred :: Nat -> Nat + pred Zero = Zero + pred (Succ n) = n + type family Equals_0123456789 (a :: Nat) (b :: Nat) :: Bool where + Equals_0123456789 Zero Zero = TrueSym0 + Equals_0123456789 (Succ a) (Succ b) = (:==) a b + Equals_0123456789 (a :: Nat) (b :: Nat) = FalseSym0 + instance PEq (KProxy :: KProxy Nat) where + type (:==) (a :: Nat) (b :: Nat) = Equals_0123456789 a b + type ZeroSym0 = Zero + type SuccSym1 (t :: Nat) = Succ t + instance SuppressUnusedWarnings SuccSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) SuccSym0KindInference GHC.Tuple.()) + data SuccSym0 (l :: TyFun Nat Nat) + = forall arg. KindOf (Apply SuccSym0 arg) ~ KindOf (SuccSym1 arg) => + SuccSym0KindInference + type instance Apply SuccSym0 l = SuccSym1 l + type PredSym1 (t :: Nat) = Pred t + instance SuppressUnusedWarnings PredSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) PredSym0KindInference GHC.Tuple.()) + data PredSym0 (l :: TyFun Nat Nat) + = forall arg. KindOf (Apply PredSym0 arg) ~ KindOf (PredSym1 arg) => + PredSym0KindInference + type instance Apply PredSym0 l = PredSym1 l + type PlusSym2 (t :: Nat) (t :: Nat) = Plus t t + instance SuppressUnusedWarnings PlusSym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) PlusSym1KindInference GHC.Tuple.()) + data PlusSym1 (l :: Nat) (l :: TyFun Nat Nat) + = forall arg. KindOf (Apply (PlusSym1 l) arg) ~ KindOf (PlusSym2 l arg) => + PlusSym1KindInference + type instance Apply (PlusSym1 l) l = PlusSym2 l l + instance SuppressUnusedWarnings PlusSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) PlusSym0KindInference GHC.Tuple.()) + data PlusSym0 (l :: TyFun Nat (TyFun Nat Nat -> GHC.Types.Type)) + = forall arg. KindOf (Apply PlusSym0 arg) ~ KindOf (PlusSym1 arg) => + PlusSym0KindInference + type instance Apply PlusSym0 l = PlusSym1 l + type family Pred (a :: Nat) :: Nat where + Pred Zero = ZeroSym0 + Pred (Succ n) = n + type family Plus (a :: Nat) (a :: Nat) :: Nat where + Plus Zero m = m + Plus (Succ n) m = Apply SuccSym0 (Apply (Apply PlusSym0 n) m) + sPred :: + forall (t :: Nat). Sing t -> Sing (Apply PredSym0 t :: Nat) + sPlus :: + forall (t :: Nat) (t :: Nat). + Sing t -> Sing t -> Sing (Apply (Apply PlusSym0 t) t :: Nat) + sPred SZero + = let + lambda :: t ~ ZeroSym0 => Sing (Apply PredSym0 t :: Nat) + lambda = SZero + in lambda + sPred (SSucc sN) + = let + lambda :: + forall n. + t ~ Apply SuccSym0 n => Sing n -> Sing (Apply PredSym0 t :: Nat) + lambda n = n + in lambda sN + sPlus SZero sM + = let + lambda :: + forall m. + (t ~ ZeroSym0, t ~ m) => + Sing m -> Sing (Apply (Apply PlusSym0 t) t :: Nat) + lambda m = m + in lambda sM + sPlus (SSucc sN) sM + = let + lambda :: + forall n m. + (t ~ Apply SuccSym0 n, t ~ m) => + Sing n -> Sing m -> Sing (Apply (Apply PlusSym0 t) t :: Nat) + lambda n m + = applySing + (singFun1 (Proxy :: Proxy SuccSym0) SSucc) + (applySing + (applySing (singFun2 (Proxy :: Proxy PlusSym0) sPlus) n) m) + in lambda sN sM + data instance Sing (z :: Nat) + = z ~ Zero => SZero | + forall (n :: Nat). z ~ Succ n => SSucc (Sing (n :: Nat)) + type SNat = (Sing :: Nat -> GHC.Types.Type) + instance SingKind (KProxy :: KProxy Nat) where + type DemoteRep (KProxy :: KProxy Nat) = Nat + fromSing SZero = Zero + fromSing (SSucc b) = Succ (fromSing b) + toSing Zero = SomeSing SZero + toSing (Succ b) + = case toSing b :: SomeSing (KProxy :: KProxy Nat) of { + SomeSing c -> SomeSing (SSucc c) } + instance SEq (KProxy :: KProxy Nat) where + (%:==) SZero SZero = STrue + (%:==) SZero (SSucc _) = SFalse + (%:==) (SSucc _) SZero = SFalse + (%:==) (SSucc a) (SSucc b) = (%:==) a b + instance SDecide (KProxy :: KProxy Nat) where + (%~) SZero SZero = Proved Refl + (%~) SZero (SSucc _) + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) (SSucc _) SZero + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) (SSucc a) (SSucc b) + = case (%~) a b of { + Proved Refl -> Proved Refl + Disproved contra + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) } + instance SingI Zero where + sing = SZero + instance SingI n => SingI (Succ (n :: Nat)) where + sing = SSucc sing diff --git a/tests/compile-and-dump/Singletons/Operators.ghc710.template b/tests/compile-and-dump/Singletons/Operators.ghc710.template --- a/tests/compile-and-dump/Singletons/Operators.ghc710.template +++ b/tests/compile-and-dump/Singletons/Operators.ghc710.template @@ -73,15 +73,14 @@ = let lambda :: forall m. (t ~ ZeroSym0, t ~ m) => - Sing m -> Sing (Apply (Apply (:+$) ZeroSym0) m :: Nat) + Sing m -> Sing (Apply (Apply (:+$) t) t :: Nat) lambda m = m in lambda sM (%:+) (SSucc sN) sM = let lambda :: forall n m. (t ~ Apply SuccSym0 n, t ~ m) => - Sing n - -> Sing m -> Sing (Apply (Apply (:+$) (Apply SuccSym0 n)) m :: Nat) + Sing n -> Sing m -> Sing (Apply (Apply (:+$) t) t :: Nat) lambda n m = applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) @@ -89,16 +88,14 @@ in lambda sN sM sChild SFLeaf = let - lambda :: t ~ FLeafSym0 => Sing (Apply ChildSym0 FLeafSym0 :: Foo) + lambda :: t ~ FLeafSym0 => Sing (Apply ChildSym0 t :: Foo) lambda = SFLeaf in lambda sChild ((:%+:) sA _s_z_0123456789) = let lambda :: forall a _z_0123456789. t ~ Apply (Apply (:+:$) a) _z_0123456789 => - Sing a - -> Sing _z_0123456789 - -> Sing (Apply ChildSym0 (Apply (Apply (:+:$) a) _z_0123456789) :: Foo) + Sing a -> Sing _z_0123456789 -> Sing (Apply ChildSym0 t :: Foo) lambda a _z_0123456789 = a in lambda sA _s_z_0123456789 data instance Sing (z :: Foo) diff --git a/tests/compile-and-dump/Singletons/Operators.ghc80.template b/tests/compile-and-dump/Singletons/Operators.ghc80.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/Operators.ghc80.template @@ -0,0 +1,128 @@ +Singletons/Operators.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| child :: Foo -> Foo + child FLeaf = FLeaf + child (a :+: _) = a + (+) :: Nat -> Nat -> Nat + Zero + m = m + (Succ n) + m = Succ (n + m) + + data Foo + where + FLeaf :: Foo + (:+:) :: Foo -> Foo -> Foo |] + ======> + data Foo + where + FLeaf :: Foo + (:+:) :: Foo -> Foo -> Foo + child :: Foo -> Foo + child FLeaf = FLeaf + child (a :+: _) = a + (+) :: Nat -> Nat -> Nat + (+) Zero m = m + (+) (Succ n) m = Succ (n + m) + type FLeafSym0 = FLeaf + type (:+:$$$) (t :: Foo) (t :: Foo) = (:+:) t t + instance SuppressUnusedWarnings (:+:$$) where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) (:+:$$###) GHC.Tuple.()) + data (:+:$$) (l :: Foo) (l :: TyFun Foo Foo) + = forall arg. KindOf (Apply ((:+:$$) l) arg) ~ KindOf ((:+:$$$) l arg) => + (:+:$$###) + type instance Apply ((:+:$$) l) l = (:+:$$$) l l + instance SuppressUnusedWarnings (:+:$) where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) (:+:$###) GHC.Tuple.()) + data (:+:$) (l :: TyFun Foo (TyFun Foo Foo -> GHC.Types.Type)) + = forall arg. KindOf (Apply (:+:$) arg) ~ KindOf ((:+:$$) arg) => + (:+:$###) + type instance Apply (:+:$) l = (:+:$$) l + type (:+$$$) (t :: Nat) (t :: Nat) = (:+) t t + instance SuppressUnusedWarnings (:+$$) where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) (:+$$###) GHC.Tuple.()) + data (:+$$) (l :: Nat) (l :: TyFun Nat Nat) + = forall arg. KindOf (Apply ((:+$$) l) arg) ~ KindOf ((:+$$$) l arg) => + (:+$$###) + type instance Apply ((:+$$) l) l = (:+$$$) l l + instance SuppressUnusedWarnings (:+$) where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) (:+$###) GHC.Tuple.()) + data (:+$) (l :: TyFun Nat (TyFun Nat Nat -> GHC.Types.Type)) + = forall arg. KindOf (Apply (:+$) arg) ~ KindOf ((:+$$) arg) => + (:+$###) + type instance Apply (:+$) l = (:+$$) l + type ChildSym1 (t :: Foo) = Child t + instance SuppressUnusedWarnings ChildSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) ChildSym0KindInference GHC.Tuple.()) + data ChildSym0 (l :: TyFun Foo Foo) + = forall arg. KindOf (Apply ChildSym0 arg) ~ KindOf (ChildSym1 arg) => + ChildSym0KindInference + type instance Apply ChildSym0 l = ChildSym1 l + type family (:+) (a :: Nat) (a :: Nat) :: Nat where + (:+) Zero m = m + (:+) (Succ n) m = Apply SuccSym0 (Apply (Apply (:+$) n) m) + type family Child (a :: Foo) :: Foo where + Child FLeaf = FLeafSym0 + Child ((:+:) a _z_0123456789) = a + (%:+) :: + forall (t :: Nat) (t :: Nat). + Sing t -> Sing t -> Sing (Apply (Apply (:+$) t) t :: Nat) + sChild :: + forall (t :: Foo). Sing t -> Sing (Apply ChildSym0 t :: Foo) + (%:+) SZero sM + = let + lambda :: + forall m. + (t ~ ZeroSym0, t ~ m) => + Sing m -> Sing (Apply (Apply (:+$) t) t :: Nat) + lambda m = m + in lambda sM + (%:+) (SSucc sN) sM + = let + lambda :: + forall n m. + (t ~ Apply SuccSym0 n, t ~ m) => + Sing n -> Sing m -> Sing (Apply (Apply (:+$) t) t :: Nat) + lambda n m + = applySing + (singFun1 (Proxy :: Proxy SuccSym0) SSucc) + (applySing (applySing (singFun2 (Proxy :: Proxy (:+$)) (%:+)) n) m) + in lambda sN sM + sChild SFLeaf + = let + lambda :: t ~ FLeafSym0 => Sing (Apply ChildSym0 t :: Foo) + lambda = SFLeaf + in lambda + sChild ((:%+:) sA _s_z_0123456789) + = let + lambda :: + forall a _z_0123456789. + t ~ Apply (Apply (:+:$) a) _z_0123456789 => + Sing a -> Sing _z_0123456789 -> Sing (Apply ChildSym0 t :: Foo) + lambda a _z_0123456789 = a + in lambda sA _s_z_0123456789 + data instance Sing (z :: Foo) + = z ~ FLeaf => SFLeaf | + forall (n :: Foo) (n :: Foo). z ~ (:+:) n n => + (:%+:) (Sing (n :: Foo)) (Sing (n :: Foo)) + type SFoo = (Sing :: Foo -> GHC.Types.Type) + instance SingKind (KProxy :: KProxy Foo) where + type DemoteRep (KProxy :: KProxy Foo) = Foo + fromSing SFLeaf = FLeaf + fromSing ((:%+:) b b) = (:+:) (fromSing b) (fromSing b) + toSing FLeaf = SomeSing SFLeaf + toSing ((:+:) b b) + = case + GHC.Tuple.(,) + (toSing b :: SomeSing (KProxy :: KProxy Foo)) + (toSing b :: SomeSing (KProxy :: KProxy Foo)) + of { + GHC.Tuple.(,) (SomeSing c) (SomeSing c) -> SomeSing ((:%+:) c c) } + instance SingI FLeaf where + sing = SFLeaf + instance (SingI n, SingI n) => + SingI ((:+:) (n :: Foo) (n :: Foo)) where + sing = (:%+:) sing sing diff --git a/tests/compile-and-dump/Singletons/OrdDeriving.ghc710.template b/tests/compile-and-dump/Singletons/OrdDeriving.ghc710.template --- a/tests/compile-and-dump/Singletons/OrdDeriving.ghc710.template +++ b/tests/compile-and-dump/Singletons/OrdDeriving.ghc710.template @@ -49,213 +49,273 @@ Equals_0123456789 (a :: Foo k k k k) (b :: Foo k k k k) = FalseSym0 instance PEq (KProxy :: KProxy (Foo k k k k)) where type (:==) (a :: Foo k k k k) (b :: Foo k k k k) = Equals_0123456789 a b - type ASym4 (t :: a) (t :: b) (t :: c) (t :: d) = A t t t t + type ASym4 (t :: a0123456789) + (t :: b0123456789) + (t :: c0123456789) + (t :: d0123456789) = + A t t t t instance SuppressUnusedWarnings ASym3 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) ASym3KindInference GHC.Tuple.()) - data ASym3 (l :: a) (l :: b) (l :: c) (l :: TyFun d (Foo a b c d)) + data ASym3 (l :: a0123456789) + (l :: b0123456789) + (l :: c0123456789) + (l :: TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789)) = forall arg. KindOf (Apply (ASym3 l l l) arg) ~ KindOf (ASym4 l l l arg) => ASym3KindInference type instance Apply (ASym3 l l l) l = ASym4 l l l l instance SuppressUnusedWarnings ASym2 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) ASym2KindInference GHC.Tuple.()) - data ASym2 (l :: a) - (l :: b) - (l :: TyFun c (TyFun d (Foo a b c d) -> *)) + data ASym2 (l :: a0123456789) + (l :: b0123456789) + (l :: TyFun c0123456789 (TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789) + -> *)) = forall arg. KindOf (Apply (ASym2 l l) arg) ~ KindOf (ASym3 l l arg) => ASym2KindInference type instance Apply (ASym2 l l) l = ASym3 l l l instance SuppressUnusedWarnings ASym1 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) ASym1KindInference GHC.Tuple.()) - data ASym1 (l :: a) - (l :: TyFun b (TyFun c (TyFun d (Foo a b c d) -> *) -> *)) + data ASym1 (l :: a0123456789) + (l :: TyFun b0123456789 (TyFun c0123456789 (TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789) + -> *) + -> *)) = forall arg. KindOf (Apply (ASym1 l) arg) ~ KindOf (ASym2 l arg) => ASym1KindInference type instance Apply (ASym1 l) l = ASym2 l l instance SuppressUnusedWarnings ASym0 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) ASym0KindInference GHC.Tuple.()) - data ASym0 (l :: TyFun a (TyFun b (TyFun c (TyFun d (Foo a b c d) - -> *) - -> *) - -> *)) + data ASym0 (l :: TyFun a0123456789 (TyFun b0123456789 (TyFun c0123456789 (TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789) + -> *) + -> *) + -> *)) = forall arg. KindOf (Apply ASym0 arg) ~ KindOf (ASym1 arg) => ASym0KindInference type instance Apply ASym0 l = ASym1 l - type BSym4 (t :: a) (t :: b) (t :: c) (t :: d) = B t t t t + type BSym4 (t :: a0123456789) + (t :: b0123456789) + (t :: c0123456789) + (t :: d0123456789) = + B t t t t instance SuppressUnusedWarnings BSym3 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) BSym3KindInference GHC.Tuple.()) - data BSym3 (l :: a) (l :: b) (l :: c) (l :: TyFun d (Foo a b c d)) + data BSym3 (l :: a0123456789) + (l :: b0123456789) + (l :: c0123456789) + (l :: TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789)) = forall arg. KindOf (Apply (BSym3 l l l) arg) ~ KindOf (BSym4 l l l arg) => BSym3KindInference type instance Apply (BSym3 l l l) l = BSym4 l l l l instance SuppressUnusedWarnings BSym2 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) BSym2KindInference GHC.Tuple.()) - data BSym2 (l :: a) - (l :: b) - (l :: TyFun c (TyFun d (Foo a b c d) -> *)) + data BSym2 (l :: a0123456789) + (l :: b0123456789) + (l :: TyFun c0123456789 (TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789) + -> *)) = forall arg. KindOf (Apply (BSym2 l l) arg) ~ KindOf (BSym3 l l arg) => BSym2KindInference type instance Apply (BSym2 l l) l = BSym3 l l l instance SuppressUnusedWarnings BSym1 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) BSym1KindInference GHC.Tuple.()) - data BSym1 (l :: a) - (l :: TyFun b (TyFun c (TyFun d (Foo a b c d) -> *) -> *)) + data BSym1 (l :: a0123456789) + (l :: TyFun b0123456789 (TyFun c0123456789 (TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789) + -> *) + -> *)) = forall arg. KindOf (Apply (BSym1 l) arg) ~ KindOf (BSym2 l arg) => BSym1KindInference type instance Apply (BSym1 l) l = BSym2 l l instance SuppressUnusedWarnings BSym0 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) BSym0KindInference GHC.Tuple.()) - data BSym0 (l :: TyFun a (TyFun b (TyFun c (TyFun d (Foo a b c d) - -> *) - -> *) - -> *)) + data BSym0 (l :: TyFun a0123456789 (TyFun b0123456789 (TyFun c0123456789 (TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789) + -> *) + -> *) + -> *)) = forall arg. KindOf (Apply BSym0 arg) ~ KindOf (BSym1 arg) => BSym0KindInference type instance Apply BSym0 l = BSym1 l - type CSym4 (t :: a) (t :: b) (t :: c) (t :: d) = C t t t t + type CSym4 (t :: a0123456789) + (t :: b0123456789) + (t :: c0123456789) + (t :: d0123456789) = + C t t t t instance SuppressUnusedWarnings CSym3 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) CSym3KindInference GHC.Tuple.()) - data CSym3 (l :: a) (l :: b) (l :: c) (l :: TyFun d (Foo a b c d)) + data CSym3 (l :: a0123456789) + (l :: b0123456789) + (l :: c0123456789) + (l :: TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789)) = forall arg. KindOf (Apply (CSym3 l l l) arg) ~ KindOf (CSym4 l l l arg) => CSym3KindInference type instance Apply (CSym3 l l l) l = CSym4 l l l l instance SuppressUnusedWarnings CSym2 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) CSym2KindInference GHC.Tuple.()) - data CSym2 (l :: a) - (l :: b) - (l :: TyFun c (TyFun d (Foo a b c d) -> *)) + data CSym2 (l :: a0123456789) + (l :: b0123456789) + (l :: TyFun c0123456789 (TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789) + -> *)) = forall arg. KindOf (Apply (CSym2 l l) arg) ~ KindOf (CSym3 l l arg) => CSym2KindInference type instance Apply (CSym2 l l) l = CSym3 l l l instance SuppressUnusedWarnings CSym1 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) CSym1KindInference GHC.Tuple.()) - data CSym1 (l :: a) - (l :: TyFun b (TyFun c (TyFun d (Foo a b c d) -> *) -> *)) + data CSym1 (l :: a0123456789) + (l :: TyFun b0123456789 (TyFun c0123456789 (TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789) + -> *) + -> *)) = forall arg. KindOf (Apply (CSym1 l) arg) ~ KindOf (CSym2 l arg) => CSym1KindInference type instance Apply (CSym1 l) l = CSym2 l l instance SuppressUnusedWarnings CSym0 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) CSym0KindInference GHC.Tuple.()) - data CSym0 (l :: TyFun a (TyFun b (TyFun c (TyFun d (Foo a b c d) - -> *) - -> *) - -> *)) + data CSym0 (l :: TyFun a0123456789 (TyFun b0123456789 (TyFun c0123456789 (TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789) + -> *) + -> *) + -> *)) = forall arg. KindOf (Apply CSym0 arg) ~ KindOf (CSym1 arg) => CSym0KindInference type instance Apply CSym0 l = CSym1 l - type DSym4 (t :: a) (t :: b) (t :: c) (t :: d) = D t t t t + type DSym4 (t :: a0123456789) + (t :: b0123456789) + (t :: c0123456789) + (t :: d0123456789) = + D t t t t instance SuppressUnusedWarnings DSym3 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) DSym3KindInference GHC.Tuple.()) - data DSym3 (l :: a) (l :: b) (l :: c) (l :: TyFun d (Foo a b c d)) + data DSym3 (l :: a0123456789) + (l :: b0123456789) + (l :: c0123456789) + (l :: TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789)) = forall arg. KindOf (Apply (DSym3 l l l) arg) ~ KindOf (DSym4 l l l arg) => DSym3KindInference type instance Apply (DSym3 l l l) l = DSym4 l l l l instance SuppressUnusedWarnings DSym2 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) DSym2KindInference GHC.Tuple.()) - data DSym2 (l :: a) - (l :: b) - (l :: TyFun c (TyFun d (Foo a b c d) -> *)) + data DSym2 (l :: a0123456789) + (l :: b0123456789) + (l :: TyFun c0123456789 (TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789) + -> *)) = forall arg. KindOf (Apply (DSym2 l l) arg) ~ KindOf (DSym3 l l arg) => DSym2KindInference type instance Apply (DSym2 l l) l = DSym3 l l l instance SuppressUnusedWarnings DSym1 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) DSym1KindInference GHC.Tuple.()) - data DSym1 (l :: a) - (l :: TyFun b (TyFun c (TyFun d (Foo a b c d) -> *) -> *)) + data DSym1 (l :: a0123456789) + (l :: TyFun b0123456789 (TyFun c0123456789 (TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789) + -> *) + -> *)) = forall arg. KindOf (Apply (DSym1 l) arg) ~ KindOf (DSym2 l arg) => DSym1KindInference type instance Apply (DSym1 l) l = DSym2 l l instance SuppressUnusedWarnings DSym0 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) DSym0KindInference GHC.Tuple.()) - data DSym0 (l :: TyFun a (TyFun b (TyFun c (TyFun d (Foo a b c d) - -> *) - -> *) - -> *)) + data DSym0 (l :: TyFun a0123456789 (TyFun b0123456789 (TyFun c0123456789 (TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789) + -> *) + -> *) + -> *)) = forall arg. KindOf (Apply DSym0 arg) ~ KindOf (DSym1 arg) => DSym0KindInference type instance Apply DSym0 l = DSym1 l - type ESym4 (t :: a) (t :: b) (t :: c) (t :: d) = E t t t t + type ESym4 (t :: a0123456789) + (t :: b0123456789) + (t :: c0123456789) + (t :: d0123456789) = + E t t t t instance SuppressUnusedWarnings ESym3 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) ESym3KindInference GHC.Tuple.()) - data ESym3 (l :: a) (l :: b) (l :: c) (l :: TyFun d (Foo a b c d)) + data ESym3 (l :: a0123456789) + (l :: b0123456789) + (l :: c0123456789) + (l :: TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789)) = forall arg. KindOf (Apply (ESym3 l l l) arg) ~ KindOf (ESym4 l l l arg) => ESym3KindInference type instance Apply (ESym3 l l l) l = ESym4 l l l l instance SuppressUnusedWarnings ESym2 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) ESym2KindInference GHC.Tuple.()) - data ESym2 (l :: a) - (l :: b) - (l :: TyFun c (TyFun d (Foo a b c d) -> *)) + data ESym2 (l :: a0123456789) + (l :: b0123456789) + (l :: TyFun c0123456789 (TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789) + -> *)) = forall arg. KindOf (Apply (ESym2 l l) arg) ~ KindOf (ESym3 l l arg) => ESym2KindInference type instance Apply (ESym2 l l) l = ESym3 l l l instance SuppressUnusedWarnings ESym1 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) ESym1KindInference GHC.Tuple.()) - data ESym1 (l :: a) - (l :: TyFun b (TyFun c (TyFun d (Foo a b c d) -> *) -> *)) + data ESym1 (l :: a0123456789) + (l :: TyFun b0123456789 (TyFun c0123456789 (TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789) + -> *) + -> *)) = forall arg. KindOf (Apply (ESym1 l) arg) ~ KindOf (ESym2 l arg) => ESym1KindInference type instance Apply (ESym1 l) l = ESym2 l l instance SuppressUnusedWarnings ESym0 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) ESym0KindInference GHC.Tuple.()) - data ESym0 (l :: TyFun a (TyFun b (TyFun c (TyFun d (Foo a b c d) - -> *) - -> *) - -> *)) + data ESym0 (l :: TyFun a0123456789 (TyFun b0123456789 (TyFun c0123456789 (TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789) + -> *) + -> *) + -> *)) = forall arg. KindOf (Apply ESym0 arg) ~ KindOf (ESym1 arg) => ESym0KindInference type instance Apply ESym0 l = ESym1 l - type FSym4 (t :: a) (t :: b) (t :: c) (t :: d) = F t t t t + type FSym4 (t :: a0123456789) + (t :: b0123456789) + (t :: c0123456789) + (t :: d0123456789) = + F t t t t instance SuppressUnusedWarnings FSym3 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) FSym3KindInference GHC.Tuple.()) - data FSym3 (l :: a) (l :: b) (l :: c) (l :: TyFun d (Foo a b c d)) + data FSym3 (l :: a0123456789) + (l :: b0123456789) + (l :: c0123456789) + (l :: TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789)) = forall arg. KindOf (Apply (FSym3 l l l) arg) ~ KindOf (FSym4 l l l arg) => FSym3KindInference type instance Apply (FSym3 l l l) l = FSym4 l l l l instance SuppressUnusedWarnings FSym2 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) FSym2KindInference GHC.Tuple.()) - data FSym2 (l :: a) - (l :: b) - (l :: TyFun c (TyFun d (Foo a b c d) -> *)) + data FSym2 (l :: a0123456789) + (l :: b0123456789) + (l :: TyFun c0123456789 (TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789) + -> *)) = forall arg. KindOf (Apply (FSym2 l l) arg) ~ KindOf (FSym3 l l arg) => FSym2KindInference type instance Apply (FSym2 l l) l = FSym3 l l l instance SuppressUnusedWarnings FSym1 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) FSym1KindInference GHC.Tuple.()) - data FSym1 (l :: a) - (l :: TyFun b (TyFun c (TyFun d (Foo a b c d) -> *) -> *)) + data FSym1 (l :: a0123456789) + (l :: TyFun b0123456789 (TyFun c0123456789 (TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789) + -> *) + -> *)) = forall arg. KindOf (Apply (FSym1 l) arg) ~ KindOf (FSym2 l arg) => FSym1KindInference type instance Apply (FSym1 l) l = FSym2 l l instance SuppressUnusedWarnings FSym0 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) FSym0KindInference GHC.Tuple.()) - data FSym0 (l :: TyFun a (TyFun b (TyFun c (TyFun d (Foo a b c d) - -> *) - -> *) - -> *)) + data FSym0 (l :: TyFun a0123456789 (TyFun b0123456789 (TyFun c0123456789 (TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789) + -> *) + -> *) + -> *)) = forall arg. KindOf (Apply FSym0 arg) ~ KindOf (FSym1 arg) => FSym0KindInference type instance Apply FSym0 l = FSym1 l @@ -324,14 +384,15 @@ Compare_0123456789 (F _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (C _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = GTSym0 Compare_0123456789 (F _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (D _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = GTSym0 Compare_0123456789 (F _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (E _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = GTSym0 - type Compare_0123456789Sym2 (t :: Foo a b c d) (t :: Foo a b c d) = + type Compare_0123456789Sym2 (t :: Foo a0123456789 b0123456789 c0123456789 d0123456789) + (t :: Foo a0123456789 b0123456789 c0123456789 d0123456789) = Compare_0123456789 t t instance SuppressUnusedWarnings Compare_0123456789Sym1 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) Compare_0123456789Sym1KindInference GHC.Tuple.()) - data Compare_0123456789Sym1 (l :: Foo a b c d) - (l :: TyFun (Foo a b c d) Ordering) + data Compare_0123456789Sym1 (l :: Foo a0123456789 b0123456789 c0123456789 d0123456789) + (l :: TyFun (Foo a0123456789 b0123456789 c0123456789 d0123456789) Ordering) = forall arg. KindOf (Apply (Compare_0123456789Sym1 l) arg) ~ KindOf (Compare_0123456789Sym2 l arg) => Compare_0123456789Sym1KindInference type instance Apply (Compare_0123456789Sym1 l) l = Compare_0123456789Sym2 l l @@ -339,8 +400,8 @@ suppressUnusedWarnings _ = snd (GHC.Tuple.(,) Compare_0123456789Sym0KindInference GHC.Tuple.()) - data Compare_0123456789Sym0 (l :: TyFun (Foo a b c d) (TyFun (Foo a b c d) Ordering - -> *)) + data Compare_0123456789Sym0 (l :: TyFun (Foo a0123456789 b0123456789 c0123456789 d0123456789) (TyFun (Foo a0123456789 b0123456789 c0123456789 d0123456789) Ordering + -> *)) = forall arg. KindOf (Apply Compare_0123456789Sym0 arg) ~ KindOf (Compare_0123456789Sym1 arg) => Compare_0123456789Sym0KindInference type instance Apply Compare_0123456789Sym0 l = Compare_0123456789Sym1 l @@ -802,7 +863,7 @@ = let lambda :: (t0 ~ ZeroSym0, t1 ~ ZeroSym0) => - Sing (Apply (Apply CompareSym0 ZeroSym0) ZeroSym0 :: Ordering) + Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda = applySing (applySing @@ -820,7 +881,7 @@ t1 ~ Apply SuccSym0 b_0123456789) => Sing a_0123456789 -> Sing b_0123456789 - -> Sing (Apply (Apply CompareSym0 (Apply SuccSym0 a_0123456789)) (Apply SuccSym0 b_0123456789) :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda a_0123456789 b_0123456789 = applySing (applySing @@ -843,7 +904,7 @@ forall _z_0123456789. (t0 ~ ZeroSym0, t1 ~ Apply SuccSym0 _z_0123456789) => Sing _z_0123456789 - -> Sing (Apply (Apply CompareSym0 ZeroSym0) (Apply SuccSym0 _z_0123456789) :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda _z_0123456789 = SLT in lambda _s_z_0123456789 sCompare (SSucc _s_z_0123456789) SZero @@ -852,7 +913,7 @@ forall _z_0123456789. (t0 ~ Apply SuccSym0 _z_0123456789, t1 ~ ZeroSym0) => Sing _z_0123456789 - -> Sing (Apply (Apply CompareSym0 (Apply SuccSym0 _z_0123456789)) ZeroSym0 :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda _z_0123456789 = SGT in lambda _s_z_0123456789 instance (SOrd (KProxy :: KProxy a), @@ -890,7 +951,7 @@ -> Sing b_0123456789 -> Sing b_0123456789 -> Sing b_0123456789 - -> Sing (Apply (Apply CompareSym0 (Apply (Apply (Apply (Apply ASym0 a_0123456789) a_0123456789) a_0123456789) a_0123456789)) (Apply (Apply (Apply (Apply ASym0 b_0123456789) b_0123456789) b_0123456789) b_0123456789) :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda a_0123456789 a_0123456789 @@ -968,7 +1029,7 @@ -> Sing b_0123456789 -> Sing b_0123456789 -> Sing b_0123456789 - -> Sing (Apply (Apply CompareSym0 (Apply (Apply (Apply (Apply BSym0 a_0123456789) a_0123456789) a_0123456789) a_0123456789)) (Apply (Apply (Apply (Apply BSym0 b_0123456789) b_0123456789) b_0123456789) b_0123456789) :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda a_0123456789 a_0123456789 @@ -1046,7 +1107,7 @@ -> Sing b_0123456789 -> Sing b_0123456789 -> Sing b_0123456789 - -> Sing (Apply (Apply CompareSym0 (Apply (Apply (Apply (Apply CSym0 a_0123456789) a_0123456789) a_0123456789) a_0123456789)) (Apply (Apply (Apply (Apply CSym0 b_0123456789) b_0123456789) b_0123456789) b_0123456789) :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda a_0123456789 a_0123456789 @@ -1124,7 +1185,7 @@ -> Sing b_0123456789 -> Sing b_0123456789 -> Sing b_0123456789 - -> Sing (Apply (Apply CompareSym0 (Apply (Apply (Apply (Apply DSym0 a_0123456789) a_0123456789) a_0123456789) a_0123456789)) (Apply (Apply (Apply (Apply DSym0 b_0123456789) b_0123456789) b_0123456789) b_0123456789) :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda a_0123456789 a_0123456789 @@ -1202,7 +1263,7 @@ -> Sing b_0123456789 -> Sing b_0123456789 -> Sing b_0123456789 - -> Sing (Apply (Apply CompareSym0 (Apply (Apply (Apply (Apply ESym0 a_0123456789) a_0123456789) a_0123456789) a_0123456789)) (Apply (Apply (Apply (Apply ESym0 b_0123456789) b_0123456789) b_0123456789) b_0123456789) :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda a_0123456789 a_0123456789 @@ -1280,7 +1341,7 @@ -> Sing b_0123456789 -> Sing b_0123456789 -> Sing b_0123456789 - -> Sing (Apply (Apply CompareSym0 (Apply (Apply (Apply (Apply FSym0 a_0123456789) a_0123456789) a_0123456789) a_0123456789)) (Apply (Apply (Apply (Apply FSym0 b_0123456789) b_0123456789) b_0123456789) b_0123456789) :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda a_0123456789 a_0123456789 @@ -1364,7 +1425,7 @@ -> Sing _z_0123456789 -> Sing _z_0123456789 -> Sing _z_0123456789 - -> Sing (Apply (Apply CompareSym0 (Apply (Apply (Apply (Apply ASym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789)) (Apply (Apply (Apply (Apply BSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda _z_0123456789 _z_0123456789 @@ -1413,7 +1474,7 @@ -> Sing _z_0123456789 -> Sing _z_0123456789 -> Sing _z_0123456789 - -> Sing (Apply (Apply CompareSym0 (Apply (Apply (Apply (Apply ASym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789)) (Apply (Apply (Apply (Apply CSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda _z_0123456789 _z_0123456789 @@ -1462,7 +1523,7 @@ -> Sing _z_0123456789 -> Sing _z_0123456789 -> Sing _z_0123456789 - -> Sing (Apply (Apply CompareSym0 (Apply (Apply (Apply (Apply ASym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789)) (Apply (Apply (Apply (Apply DSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda _z_0123456789 _z_0123456789 @@ -1511,7 +1572,7 @@ -> Sing _z_0123456789 -> Sing _z_0123456789 -> Sing _z_0123456789 - -> Sing (Apply (Apply CompareSym0 (Apply (Apply (Apply (Apply ASym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789)) (Apply (Apply (Apply (Apply ESym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda _z_0123456789 _z_0123456789 @@ -1560,7 +1621,7 @@ -> Sing _z_0123456789 -> Sing _z_0123456789 -> Sing _z_0123456789 - -> Sing (Apply (Apply CompareSym0 (Apply (Apply (Apply (Apply ASym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789)) (Apply (Apply (Apply (Apply FSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda _z_0123456789 _z_0123456789 @@ -1609,7 +1670,7 @@ -> Sing _z_0123456789 -> Sing _z_0123456789 -> Sing _z_0123456789 - -> Sing (Apply (Apply CompareSym0 (Apply (Apply (Apply (Apply BSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789)) (Apply (Apply (Apply (Apply ASym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda _z_0123456789 _z_0123456789 @@ -1658,7 +1719,7 @@ -> Sing _z_0123456789 -> Sing _z_0123456789 -> Sing _z_0123456789 - -> Sing (Apply (Apply CompareSym0 (Apply (Apply (Apply (Apply BSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789)) (Apply (Apply (Apply (Apply CSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda _z_0123456789 _z_0123456789 @@ -1707,7 +1768,7 @@ -> Sing _z_0123456789 -> Sing _z_0123456789 -> Sing _z_0123456789 - -> Sing (Apply (Apply CompareSym0 (Apply (Apply (Apply (Apply BSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789)) (Apply (Apply (Apply (Apply DSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda _z_0123456789 _z_0123456789 @@ -1756,7 +1817,7 @@ -> Sing _z_0123456789 -> Sing _z_0123456789 -> Sing _z_0123456789 - -> Sing (Apply (Apply CompareSym0 (Apply (Apply (Apply (Apply BSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789)) (Apply (Apply (Apply (Apply ESym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda _z_0123456789 _z_0123456789 @@ -1805,7 +1866,7 @@ -> Sing _z_0123456789 -> Sing _z_0123456789 -> Sing _z_0123456789 - -> Sing (Apply (Apply CompareSym0 (Apply (Apply (Apply (Apply BSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789)) (Apply (Apply (Apply (Apply FSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda _z_0123456789 _z_0123456789 @@ -1854,7 +1915,7 @@ -> Sing _z_0123456789 -> Sing _z_0123456789 -> Sing _z_0123456789 - -> Sing (Apply (Apply CompareSym0 (Apply (Apply (Apply (Apply CSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789)) (Apply (Apply (Apply (Apply ASym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda _z_0123456789 _z_0123456789 @@ -1903,7 +1964,7 @@ -> Sing _z_0123456789 -> Sing _z_0123456789 -> Sing _z_0123456789 - -> Sing (Apply (Apply CompareSym0 (Apply (Apply (Apply (Apply CSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789)) (Apply (Apply (Apply (Apply BSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda _z_0123456789 _z_0123456789 @@ -1952,7 +2013,7 @@ -> Sing _z_0123456789 -> Sing _z_0123456789 -> Sing _z_0123456789 - -> Sing (Apply (Apply CompareSym0 (Apply (Apply (Apply (Apply CSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789)) (Apply (Apply (Apply (Apply DSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda _z_0123456789 _z_0123456789 @@ -2001,7 +2062,7 @@ -> Sing _z_0123456789 -> Sing _z_0123456789 -> Sing _z_0123456789 - -> Sing (Apply (Apply CompareSym0 (Apply (Apply (Apply (Apply CSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789)) (Apply (Apply (Apply (Apply ESym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda _z_0123456789 _z_0123456789 @@ -2050,7 +2111,7 @@ -> Sing _z_0123456789 -> Sing _z_0123456789 -> Sing _z_0123456789 - -> Sing (Apply (Apply CompareSym0 (Apply (Apply (Apply (Apply CSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789)) (Apply (Apply (Apply (Apply FSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda _z_0123456789 _z_0123456789 @@ -2099,7 +2160,7 @@ -> Sing _z_0123456789 -> Sing _z_0123456789 -> Sing _z_0123456789 - -> Sing (Apply (Apply CompareSym0 (Apply (Apply (Apply (Apply DSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789)) (Apply (Apply (Apply (Apply ASym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda _z_0123456789 _z_0123456789 @@ -2148,7 +2209,7 @@ -> Sing _z_0123456789 -> Sing _z_0123456789 -> Sing _z_0123456789 - -> Sing (Apply (Apply CompareSym0 (Apply (Apply (Apply (Apply DSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789)) (Apply (Apply (Apply (Apply BSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda _z_0123456789 _z_0123456789 @@ -2197,7 +2258,7 @@ -> Sing _z_0123456789 -> Sing _z_0123456789 -> Sing _z_0123456789 - -> Sing (Apply (Apply CompareSym0 (Apply (Apply (Apply (Apply DSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789)) (Apply (Apply (Apply (Apply CSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda _z_0123456789 _z_0123456789 @@ -2246,7 +2307,7 @@ -> Sing _z_0123456789 -> Sing _z_0123456789 -> Sing _z_0123456789 - -> Sing (Apply (Apply CompareSym0 (Apply (Apply (Apply (Apply DSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789)) (Apply (Apply (Apply (Apply ESym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda _z_0123456789 _z_0123456789 @@ -2295,7 +2356,7 @@ -> Sing _z_0123456789 -> Sing _z_0123456789 -> Sing _z_0123456789 - -> Sing (Apply (Apply CompareSym0 (Apply (Apply (Apply (Apply DSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789)) (Apply (Apply (Apply (Apply FSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda _z_0123456789 _z_0123456789 @@ -2344,7 +2405,7 @@ -> Sing _z_0123456789 -> Sing _z_0123456789 -> Sing _z_0123456789 - -> Sing (Apply (Apply CompareSym0 (Apply (Apply (Apply (Apply ESym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789)) (Apply (Apply (Apply (Apply ASym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda _z_0123456789 _z_0123456789 @@ -2393,7 +2454,7 @@ -> Sing _z_0123456789 -> Sing _z_0123456789 -> Sing _z_0123456789 - -> Sing (Apply (Apply CompareSym0 (Apply (Apply (Apply (Apply ESym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789)) (Apply (Apply (Apply (Apply BSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda _z_0123456789 _z_0123456789 @@ -2442,7 +2503,7 @@ -> Sing _z_0123456789 -> Sing _z_0123456789 -> Sing _z_0123456789 - -> Sing (Apply (Apply CompareSym0 (Apply (Apply (Apply (Apply ESym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789)) (Apply (Apply (Apply (Apply CSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda _z_0123456789 _z_0123456789 @@ -2491,7 +2552,7 @@ -> Sing _z_0123456789 -> Sing _z_0123456789 -> Sing _z_0123456789 - -> Sing (Apply (Apply CompareSym0 (Apply (Apply (Apply (Apply ESym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789)) (Apply (Apply (Apply (Apply DSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda _z_0123456789 _z_0123456789 @@ -2540,7 +2601,7 @@ -> Sing _z_0123456789 -> Sing _z_0123456789 -> Sing _z_0123456789 - -> Sing (Apply (Apply CompareSym0 (Apply (Apply (Apply (Apply ESym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789)) (Apply (Apply (Apply (Apply FSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda _z_0123456789 _z_0123456789 @@ -2589,7 +2650,7 @@ -> Sing _z_0123456789 -> Sing _z_0123456789 -> Sing _z_0123456789 - -> Sing (Apply (Apply CompareSym0 (Apply (Apply (Apply (Apply FSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789)) (Apply (Apply (Apply (Apply ASym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda _z_0123456789 _z_0123456789 @@ -2638,7 +2699,7 @@ -> Sing _z_0123456789 -> Sing _z_0123456789 -> Sing _z_0123456789 - -> Sing (Apply (Apply CompareSym0 (Apply (Apply (Apply (Apply FSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789)) (Apply (Apply (Apply (Apply BSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda _z_0123456789 _z_0123456789 @@ -2687,7 +2748,7 @@ -> Sing _z_0123456789 -> Sing _z_0123456789 -> Sing _z_0123456789 - -> Sing (Apply (Apply CompareSym0 (Apply (Apply (Apply (Apply FSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789)) (Apply (Apply (Apply (Apply CSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda _z_0123456789 _z_0123456789 @@ -2736,7 +2797,7 @@ -> Sing _z_0123456789 -> Sing _z_0123456789 -> Sing _z_0123456789 - -> Sing (Apply (Apply CompareSym0 (Apply (Apply (Apply (Apply FSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789)) (Apply (Apply (Apply (Apply DSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda _z_0123456789 _z_0123456789 @@ -2785,7 +2846,7 @@ -> Sing _z_0123456789 -> Sing _z_0123456789 -> Sing _z_0123456789 - -> Sing (Apply (Apply CompareSym0 (Apply (Apply (Apply (Apply FSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789)) (Apply (Apply (Apply (Apply ESym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda _z_0123456789 _z_0123456789 diff --git a/tests/compile-and-dump/Singletons/OrdDeriving.ghc80.template b/tests/compile-and-dump/Singletons/OrdDeriving.ghc80.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/OrdDeriving.ghc80.template @@ -0,0 +1,2927 @@ +Singletons/OrdDeriving.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| data Nat + = Zero | Succ Nat + deriving (Eq, Ord) + data Foo a b c d + = A a b c d | + B a b c d | + C a b c d | + D a b c d | + E a b c d | + F a b c d + deriving (Eq, Ord) |] + ======> + data Nat + = Zero | Succ Nat + deriving (Eq, Ord) + data Foo a b c d + = A a b c d | + B a b c d | + C a b c d | + D a b c d | + E a b c d | + F a b c d + deriving (Eq, Ord) + type family Equals_0123456789 (a :: Nat) (b :: Nat) :: Bool where + Equals_0123456789 Zero Zero = TrueSym0 + Equals_0123456789 (Succ a) (Succ b) = (:==) a b + Equals_0123456789 (a :: Nat) (b :: Nat) = FalseSym0 + instance PEq (KProxy :: KProxy Nat) where + type (:==) (a :: Nat) (b :: Nat) = Equals_0123456789 a b + type ZeroSym0 = Zero + type SuccSym1 (t :: Nat) = Succ t + instance SuppressUnusedWarnings SuccSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) SuccSym0KindInference GHC.Tuple.()) + data SuccSym0 (l :: TyFun Nat Nat) + = forall arg. KindOf (Apply SuccSym0 arg) ~ KindOf (SuccSym1 arg) => + SuccSym0KindInference + type instance Apply SuccSym0 l = SuccSym1 l + type family Equals_0123456789 (a :: Foo k k k k) + (b :: Foo k k k k) :: Bool where + Equals_0123456789 (A a a a a) (A b b b b) = (:&&) ((:==) a b) ((:&&) ((:==) a b) ((:&&) ((:==) a b) ((:==) a b))) + Equals_0123456789 (B a a a a) (B b b b b) = (:&&) ((:==) a b) ((:&&) ((:==) a b) ((:&&) ((:==) a b) ((:==) a b))) + Equals_0123456789 (C a a a a) (C b b b b) = (:&&) ((:==) a b) ((:&&) ((:==) a b) ((:&&) ((:==) a b) ((:==) a b))) + Equals_0123456789 (D a a a a) (D b b b b) = (:&&) ((:==) a b) ((:&&) ((:==) a b) ((:&&) ((:==) a b) ((:==) a b))) + Equals_0123456789 (E a a a a) (E b b b b) = (:&&) ((:==) a b) ((:&&) ((:==) a b) ((:&&) ((:==) a b) ((:==) a b))) + Equals_0123456789 (F a a a a) (F b b b b) = (:&&) ((:==) a b) ((:&&) ((:==) a b) ((:&&) ((:==) a b) ((:==) a b))) + Equals_0123456789 (a :: Foo k k k k) (b :: Foo k k k k) = FalseSym0 + instance PEq (KProxy :: KProxy (Foo k k k k)) where + type (:==) (a :: Foo k k k k) (b :: Foo k k k k) = Equals_0123456789 a b + type ASym4 (t :: a0123456789) + (t :: b0123456789) + (t :: c0123456789) + (t :: d0123456789) = + A t t t t + instance SuppressUnusedWarnings ASym3 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) ASym3KindInference GHC.Tuple.()) + data ASym3 (l :: a0123456789) + (l :: b0123456789) + (l :: c0123456789) + (l :: TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789)) + = forall arg. KindOf (Apply (ASym3 l l l) arg) ~ KindOf (ASym4 l l l arg) => + ASym3KindInference + type instance Apply (ASym3 l l l) l = ASym4 l l l l + instance SuppressUnusedWarnings ASym2 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) ASym2KindInference GHC.Tuple.()) + data ASym2 (l :: a0123456789) + (l :: b0123456789) + (l :: TyFun c0123456789 (TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789) + -> GHC.Types.Type)) + = forall arg. KindOf (Apply (ASym2 l l) arg) ~ KindOf (ASym3 l l arg) => + ASym2KindInference + type instance Apply (ASym2 l l) l = ASym3 l l l + instance SuppressUnusedWarnings ASym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) ASym1KindInference GHC.Tuple.()) + data ASym1 (l :: a0123456789) + (l :: TyFun b0123456789 (TyFun c0123456789 (TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789) + -> GHC.Types.Type) + -> GHC.Types.Type)) + = forall arg. KindOf (Apply (ASym1 l) arg) ~ KindOf (ASym2 l arg) => + ASym1KindInference + type instance Apply (ASym1 l) l = ASym2 l l + instance SuppressUnusedWarnings ASym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) ASym0KindInference GHC.Tuple.()) + data ASym0 (l :: TyFun a0123456789 (TyFun b0123456789 (TyFun c0123456789 (TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789) + -> GHC.Types.Type) + -> GHC.Types.Type) + -> GHC.Types.Type)) + = forall arg. KindOf (Apply ASym0 arg) ~ KindOf (ASym1 arg) => + ASym0KindInference + type instance Apply ASym0 l = ASym1 l + type BSym4 (t :: a0123456789) + (t :: b0123456789) + (t :: c0123456789) + (t :: d0123456789) = + B t t t t + instance SuppressUnusedWarnings BSym3 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) BSym3KindInference GHC.Tuple.()) + data BSym3 (l :: a0123456789) + (l :: b0123456789) + (l :: c0123456789) + (l :: TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789)) + = forall arg. KindOf (Apply (BSym3 l l l) arg) ~ KindOf (BSym4 l l l arg) => + BSym3KindInference + type instance Apply (BSym3 l l l) l = BSym4 l l l l + instance SuppressUnusedWarnings BSym2 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) BSym2KindInference GHC.Tuple.()) + data BSym2 (l :: a0123456789) + (l :: b0123456789) + (l :: TyFun c0123456789 (TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789) + -> GHC.Types.Type)) + = forall arg. KindOf (Apply (BSym2 l l) arg) ~ KindOf (BSym3 l l arg) => + BSym2KindInference + type instance Apply (BSym2 l l) l = BSym3 l l l + instance SuppressUnusedWarnings BSym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) BSym1KindInference GHC.Tuple.()) + data BSym1 (l :: a0123456789) + (l :: TyFun b0123456789 (TyFun c0123456789 (TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789) + -> GHC.Types.Type) + -> GHC.Types.Type)) + = forall arg. KindOf (Apply (BSym1 l) arg) ~ KindOf (BSym2 l arg) => + BSym1KindInference + type instance Apply (BSym1 l) l = BSym2 l l + instance SuppressUnusedWarnings BSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) BSym0KindInference GHC.Tuple.()) + data BSym0 (l :: TyFun a0123456789 (TyFun b0123456789 (TyFun c0123456789 (TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789) + -> GHC.Types.Type) + -> GHC.Types.Type) + -> GHC.Types.Type)) + = forall arg. KindOf (Apply BSym0 arg) ~ KindOf (BSym1 arg) => + BSym0KindInference + type instance Apply BSym0 l = BSym1 l + type CSym4 (t :: a0123456789) + (t :: b0123456789) + (t :: c0123456789) + (t :: d0123456789) = + C t t t t + instance SuppressUnusedWarnings CSym3 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) CSym3KindInference GHC.Tuple.()) + data CSym3 (l :: a0123456789) + (l :: b0123456789) + (l :: c0123456789) + (l :: TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789)) + = forall arg. KindOf (Apply (CSym3 l l l) arg) ~ KindOf (CSym4 l l l arg) => + CSym3KindInference + type instance Apply (CSym3 l l l) l = CSym4 l l l l + instance SuppressUnusedWarnings CSym2 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) CSym2KindInference GHC.Tuple.()) + data CSym2 (l :: a0123456789) + (l :: b0123456789) + (l :: TyFun c0123456789 (TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789) + -> GHC.Types.Type)) + = forall arg. KindOf (Apply (CSym2 l l) arg) ~ KindOf (CSym3 l l arg) => + CSym2KindInference + type instance Apply (CSym2 l l) l = CSym3 l l l + instance SuppressUnusedWarnings CSym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) CSym1KindInference GHC.Tuple.()) + data CSym1 (l :: a0123456789) + (l :: TyFun b0123456789 (TyFun c0123456789 (TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789) + -> GHC.Types.Type) + -> GHC.Types.Type)) + = forall arg. KindOf (Apply (CSym1 l) arg) ~ KindOf (CSym2 l arg) => + CSym1KindInference + type instance Apply (CSym1 l) l = CSym2 l l + instance SuppressUnusedWarnings CSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) CSym0KindInference GHC.Tuple.()) + data CSym0 (l :: TyFun a0123456789 (TyFun b0123456789 (TyFun c0123456789 (TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789) + -> GHC.Types.Type) + -> GHC.Types.Type) + -> GHC.Types.Type)) + = forall arg. KindOf (Apply CSym0 arg) ~ KindOf (CSym1 arg) => + CSym0KindInference + type instance Apply CSym0 l = CSym1 l + type DSym4 (t :: a0123456789) + (t :: b0123456789) + (t :: c0123456789) + (t :: d0123456789) = + D t t t t + instance SuppressUnusedWarnings DSym3 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) DSym3KindInference GHC.Tuple.()) + data DSym3 (l :: a0123456789) + (l :: b0123456789) + (l :: c0123456789) + (l :: TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789)) + = forall arg. KindOf (Apply (DSym3 l l l) arg) ~ KindOf (DSym4 l l l arg) => + DSym3KindInference + type instance Apply (DSym3 l l l) l = DSym4 l l l l + instance SuppressUnusedWarnings DSym2 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) DSym2KindInference GHC.Tuple.()) + data DSym2 (l :: a0123456789) + (l :: b0123456789) + (l :: TyFun c0123456789 (TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789) + -> GHC.Types.Type)) + = forall arg. KindOf (Apply (DSym2 l l) arg) ~ KindOf (DSym3 l l arg) => + DSym2KindInference + type instance Apply (DSym2 l l) l = DSym3 l l l + instance SuppressUnusedWarnings DSym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) DSym1KindInference GHC.Tuple.()) + data DSym1 (l :: a0123456789) + (l :: TyFun b0123456789 (TyFun c0123456789 (TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789) + -> GHC.Types.Type) + -> GHC.Types.Type)) + = forall arg. KindOf (Apply (DSym1 l) arg) ~ KindOf (DSym2 l arg) => + DSym1KindInference + type instance Apply (DSym1 l) l = DSym2 l l + instance SuppressUnusedWarnings DSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) DSym0KindInference GHC.Tuple.()) + data DSym0 (l :: TyFun a0123456789 (TyFun b0123456789 (TyFun c0123456789 (TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789) + -> GHC.Types.Type) + -> GHC.Types.Type) + -> GHC.Types.Type)) + = forall arg. KindOf (Apply DSym0 arg) ~ KindOf (DSym1 arg) => + DSym0KindInference + type instance Apply DSym0 l = DSym1 l + type ESym4 (t :: a0123456789) + (t :: b0123456789) + (t :: c0123456789) + (t :: d0123456789) = + E t t t t + instance SuppressUnusedWarnings ESym3 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) ESym3KindInference GHC.Tuple.()) + data ESym3 (l :: a0123456789) + (l :: b0123456789) + (l :: c0123456789) + (l :: TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789)) + = forall arg. KindOf (Apply (ESym3 l l l) arg) ~ KindOf (ESym4 l l l arg) => + ESym3KindInference + type instance Apply (ESym3 l l l) l = ESym4 l l l l + instance SuppressUnusedWarnings ESym2 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) ESym2KindInference GHC.Tuple.()) + data ESym2 (l :: a0123456789) + (l :: b0123456789) + (l :: TyFun c0123456789 (TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789) + -> GHC.Types.Type)) + = forall arg. KindOf (Apply (ESym2 l l) arg) ~ KindOf (ESym3 l l arg) => + ESym2KindInference + type instance Apply (ESym2 l l) l = ESym3 l l l + instance SuppressUnusedWarnings ESym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) ESym1KindInference GHC.Tuple.()) + data ESym1 (l :: a0123456789) + (l :: TyFun b0123456789 (TyFun c0123456789 (TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789) + -> GHC.Types.Type) + -> GHC.Types.Type)) + = forall arg. KindOf (Apply (ESym1 l) arg) ~ KindOf (ESym2 l arg) => + ESym1KindInference + type instance Apply (ESym1 l) l = ESym2 l l + instance SuppressUnusedWarnings ESym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) ESym0KindInference GHC.Tuple.()) + data ESym0 (l :: TyFun a0123456789 (TyFun b0123456789 (TyFun c0123456789 (TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789) + -> GHC.Types.Type) + -> GHC.Types.Type) + -> GHC.Types.Type)) + = forall arg. KindOf (Apply ESym0 arg) ~ KindOf (ESym1 arg) => + ESym0KindInference + type instance Apply ESym0 l = ESym1 l + type FSym4 (t :: a0123456789) + (t :: b0123456789) + (t :: c0123456789) + (t :: d0123456789) = + F t t t t + instance SuppressUnusedWarnings FSym3 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) FSym3KindInference GHC.Tuple.()) + data FSym3 (l :: a0123456789) + (l :: b0123456789) + (l :: c0123456789) + (l :: TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789)) + = forall arg. KindOf (Apply (FSym3 l l l) arg) ~ KindOf (FSym4 l l l arg) => + FSym3KindInference + type instance Apply (FSym3 l l l) l = FSym4 l l l l + instance SuppressUnusedWarnings FSym2 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) FSym2KindInference GHC.Tuple.()) + data FSym2 (l :: a0123456789) + (l :: b0123456789) + (l :: TyFun c0123456789 (TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789) + -> GHC.Types.Type)) + = forall arg. KindOf (Apply (FSym2 l l) arg) ~ KindOf (FSym3 l l arg) => + FSym2KindInference + type instance Apply (FSym2 l l) l = FSym3 l l l + instance SuppressUnusedWarnings FSym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) FSym1KindInference GHC.Tuple.()) + data FSym1 (l :: a0123456789) + (l :: TyFun b0123456789 (TyFun c0123456789 (TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789) + -> GHC.Types.Type) + -> GHC.Types.Type)) + = forall arg. KindOf (Apply (FSym1 l) arg) ~ KindOf (FSym2 l arg) => + FSym1KindInference + type instance Apply (FSym1 l) l = FSym2 l l + instance SuppressUnusedWarnings FSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) FSym0KindInference GHC.Tuple.()) + data FSym0 (l :: TyFun a0123456789 (TyFun b0123456789 (TyFun c0123456789 (TyFun d0123456789 (Foo a0123456789 b0123456789 c0123456789 d0123456789) + -> GHC.Types.Type) + -> GHC.Types.Type) + -> GHC.Types.Type)) + = forall arg. KindOf (Apply FSym0 arg) ~ KindOf (FSym1 arg) => + FSym0KindInference + type instance Apply FSym0 l = FSym1 l + type family Compare_0123456789 (a :: Nat) + (a :: Nat) :: Ordering where + Compare_0123456789 Zero Zero = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] + Compare_0123456789 (Succ a_0123456789) (Succ b_0123456789) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) '[]) + Compare_0123456789 Zero (Succ _z_0123456789) = LTSym0 + Compare_0123456789 (Succ _z_0123456789) Zero = GTSym0 + type Compare_0123456789Sym2 (t :: Nat) (t :: Nat) = + Compare_0123456789 t t + instance SuppressUnusedWarnings Compare_0123456789Sym1 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Compare_0123456789Sym1KindInference GHC.Tuple.()) + data Compare_0123456789Sym1 (l :: Nat) (l :: TyFun Nat Ordering) + = forall arg. KindOf (Apply (Compare_0123456789Sym1 l) arg) ~ KindOf (Compare_0123456789Sym2 l arg) => + Compare_0123456789Sym1KindInference + type instance Apply (Compare_0123456789Sym1 l) l = Compare_0123456789Sym2 l l + instance SuppressUnusedWarnings Compare_0123456789Sym0 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Compare_0123456789Sym0KindInference GHC.Tuple.()) + data Compare_0123456789Sym0 (l :: TyFun Nat (TyFun Nat Ordering + -> GHC.Types.Type)) + = forall arg. KindOf (Apply Compare_0123456789Sym0 arg) ~ KindOf (Compare_0123456789Sym1 arg) => + Compare_0123456789Sym0KindInference + type instance Apply Compare_0123456789Sym0 l = Compare_0123456789Sym1 l + instance POrd (KProxy :: KProxy Nat) where + type Compare (a :: Nat) (a :: Nat) = Apply (Apply Compare_0123456789Sym0 a) a + type family Compare_0123456789 (a :: Foo a b c d) + (a :: Foo a b c d) :: Ordering where + Compare_0123456789 (A a_0123456789 a_0123456789 a_0123456789 a_0123456789) (A b_0123456789 b_0123456789 b_0123456789 b_0123456789) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) '[])))) + Compare_0123456789 (B a_0123456789 a_0123456789 a_0123456789 a_0123456789) (B b_0123456789 b_0123456789 b_0123456789 b_0123456789) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) '[])))) + Compare_0123456789 (C a_0123456789 a_0123456789 a_0123456789 a_0123456789) (C b_0123456789 b_0123456789 b_0123456789 b_0123456789) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) '[])))) + Compare_0123456789 (D a_0123456789 a_0123456789 a_0123456789 a_0123456789) (D b_0123456789 b_0123456789 b_0123456789 b_0123456789) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) '[])))) + Compare_0123456789 (E a_0123456789 a_0123456789 a_0123456789 a_0123456789) (E b_0123456789 b_0123456789 b_0123456789 b_0123456789) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) '[])))) + Compare_0123456789 (F a_0123456789 a_0123456789 a_0123456789 a_0123456789) (F b_0123456789 b_0123456789 b_0123456789 b_0123456789) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) '[])))) + Compare_0123456789 (A _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (B _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = LTSym0 + Compare_0123456789 (A _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (C _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = LTSym0 + Compare_0123456789 (A _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (D _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = LTSym0 + Compare_0123456789 (A _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (E _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = LTSym0 + Compare_0123456789 (A _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (F _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = LTSym0 + Compare_0123456789 (B _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (A _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = GTSym0 + Compare_0123456789 (B _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (C _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = LTSym0 + Compare_0123456789 (B _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (D _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = LTSym0 + Compare_0123456789 (B _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (E _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = LTSym0 + Compare_0123456789 (B _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (F _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = LTSym0 + Compare_0123456789 (C _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (A _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = GTSym0 + Compare_0123456789 (C _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (B _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = GTSym0 + Compare_0123456789 (C _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (D _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = LTSym0 + Compare_0123456789 (C _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (E _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = LTSym0 + Compare_0123456789 (C _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (F _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = LTSym0 + Compare_0123456789 (D _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (A _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = GTSym0 + Compare_0123456789 (D _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (B _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = GTSym0 + Compare_0123456789 (D _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (C _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = GTSym0 + Compare_0123456789 (D _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (E _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = LTSym0 + Compare_0123456789 (D _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (F _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = LTSym0 + Compare_0123456789 (E _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (A _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = GTSym0 + Compare_0123456789 (E _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (B _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = GTSym0 + Compare_0123456789 (E _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (C _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = GTSym0 + Compare_0123456789 (E _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (D _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = GTSym0 + Compare_0123456789 (E _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (F _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = LTSym0 + Compare_0123456789 (F _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (A _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = GTSym0 + Compare_0123456789 (F _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (B _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = GTSym0 + Compare_0123456789 (F _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (C _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = GTSym0 + Compare_0123456789 (F _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (D _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = GTSym0 + Compare_0123456789 (F _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) (E _z_0123456789 _z_0123456789 _z_0123456789 _z_0123456789) = GTSym0 + type Compare_0123456789Sym2 (t :: Foo a0123456789 b0123456789 c0123456789 d0123456789) + (t :: Foo a0123456789 b0123456789 c0123456789 d0123456789) = + Compare_0123456789 t t + instance SuppressUnusedWarnings Compare_0123456789Sym1 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Compare_0123456789Sym1KindInference GHC.Tuple.()) + data Compare_0123456789Sym1 (l :: Foo a0123456789 b0123456789 c0123456789 d0123456789) + (l :: TyFun (Foo a0123456789 b0123456789 c0123456789 d0123456789) Ordering) + = forall arg. KindOf (Apply (Compare_0123456789Sym1 l) arg) ~ KindOf (Compare_0123456789Sym2 l arg) => + Compare_0123456789Sym1KindInference + type instance Apply (Compare_0123456789Sym1 l) l = Compare_0123456789Sym2 l l + instance SuppressUnusedWarnings Compare_0123456789Sym0 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Compare_0123456789Sym0KindInference GHC.Tuple.()) + data Compare_0123456789Sym0 (l :: TyFun (Foo a0123456789 b0123456789 c0123456789 d0123456789) (TyFun (Foo a0123456789 b0123456789 c0123456789 d0123456789) Ordering + -> GHC.Types.Type)) + = forall arg. KindOf (Apply Compare_0123456789Sym0 arg) ~ KindOf (Compare_0123456789Sym1 arg) => + Compare_0123456789Sym0KindInference + type instance Apply Compare_0123456789Sym0 l = Compare_0123456789Sym1 l + instance POrd (KProxy :: KProxy (Foo a b c d)) where + type Compare (a :: Foo a b c d) (a :: Foo a b c d) = Apply (Apply Compare_0123456789Sym0 a) a + data instance Sing (z :: Nat) + = z ~ Zero => SZero | + forall (n :: Nat). z ~ Succ n => SSucc (Sing (n :: Nat)) + type SNat = (Sing :: Nat -> GHC.Types.Type) + instance SingKind (KProxy :: KProxy Nat) where + type DemoteRep (KProxy :: KProxy Nat) = Nat + fromSing SZero = Zero + fromSing (SSucc b) = Succ (fromSing b) + toSing Zero = SomeSing SZero + toSing (Succ b) + = case toSing b :: SomeSing (KProxy :: KProxy Nat) of { + SomeSing c -> SomeSing (SSucc c) } + instance SEq (KProxy :: KProxy Nat) where + (%:==) SZero SZero = STrue + (%:==) SZero (SSucc _) = SFalse + (%:==) (SSucc _) SZero = SFalse + (%:==) (SSucc a) (SSucc b) = (%:==) a b + instance SDecide (KProxy :: KProxy Nat) where + (%~) SZero SZero = Proved Refl + (%~) SZero (SSucc _) + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) (SSucc _) SZero + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) (SSucc a) (SSucc b) + = case (%~) a b of { + Proved Refl -> Proved Refl + Disproved contra + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) } + data instance Sing (z :: Foo a b c d) + = forall (n :: a) (n :: b) (n :: c) (n :: d). z ~ A n n n n => + SA (Sing (n :: a)) (Sing (n :: b)) (Sing (n :: c)) (Sing (n :: d)) | + forall (n :: a) (n :: b) (n :: c) (n :: d). z ~ B n n n n => + SB (Sing (n :: a)) (Sing (n :: b)) (Sing (n :: c)) (Sing (n :: d)) | + forall (n :: a) (n :: b) (n :: c) (n :: d). z ~ C n n n n => + SC (Sing (n :: a)) (Sing (n :: b)) (Sing (n :: c)) (Sing (n :: d)) | + forall (n :: a) (n :: b) (n :: c) (n :: d). z ~ D n n n n => + SD (Sing (n :: a)) (Sing (n :: b)) (Sing (n :: c)) (Sing (n :: d)) | + forall (n :: a) (n :: b) (n :: c) (n :: d). z ~ E n n n n => + SE (Sing (n :: a)) (Sing (n :: b)) (Sing (n :: c)) (Sing (n :: d)) | + forall (n :: a) (n :: b) (n :: c) (n :: d). z ~ F n n n n => + SF (Sing (n :: a)) (Sing (n :: b)) (Sing (n :: c)) (Sing (n :: d)) + type SFoo = (Sing :: Foo a b c d -> GHC.Types.Type) + instance (SingKind (KProxy :: KProxy a), + SingKind (KProxy :: KProxy b), + SingKind (KProxy :: KProxy c), + SingKind (KProxy :: KProxy d)) => + SingKind (KProxy :: KProxy (Foo a b c d)) where + type DemoteRep (KProxy :: KProxy (Foo a b c d)) = Foo (DemoteRep (KProxy :: KProxy a)) (DemoteRep (KProxy :: KProxy b)) (DemoteRep (KProxy :: KProxy c)) (DemoteRep (KProxy :: KProxy d)) + fromSing (SA b b b b) + = A (fromSing b) (fromSing b) (fromSing b) (fromSing b) + fromSing (SB b b b b) + = B (fromSing b) (fromSing b) (fromSing b) (fromSing b) + fromSing (SC b b b b) + = C (fromSing b) (fromSing b) (fromSing b) (fromSing b) + fromSing (SD b b b b) + = D (fromSing b) (fromSing b) (fromSing b) (fromSing b) + fromSing (SE b b b b) + = E (fromSing b) (fromSing b) (fromSing b) (fromSing b) + fromSing (SF b b b b) + = F (fromSing b) (fromSing b) (fromSing b) (fromSing b) + toSing (A b b b b) + = case + GHC.Tuple.(,,,) + (toSing b :: SomeSing (KProxy :: KProxy a)) + (toSing b :: SomeSing (KProxy :: KProxy b)) + (toSing b :: SomeSing (KProxy :: KProxy c)) + (toSing b :: SomeSing (KProxy :: KProxy d)) + of { + GHC.Tuple.(,,,) (SomeSing c) (SomeSing c) (SomeSing c) (SomeSing c) + -> SomeSing (SA c c c c) } + toSing (B b b b b) + = case + GHC.Tuple.(,,,) + (toSing b :: SomeSing (KProxy :: KProxy a)) + (toSing b :: SomeSing (KProxy :: KProxy b)) + (toSing b :: SomeSing (KProxy :: KProxy c)) + (toSing b :: SomeSing (KProxy :: KProxy d)) + of { + GHC.Tuple.(,,,) (SomeSing c) (SomeSing c) (SomeSing c) (SomeSing c) + -> SomeSing (SB c c c c) } + toSing (C b b b b) + = case + GHC.Tuple.(,,,) + (toSing b :: SomeSing (KProxy :: KProxy a)) + (toSing b :: SomeSing (KProxy :: KProxy b)) + (toSing b :: SomeSing (KProxy :: KProxy c)) + (toSing b :: SomeSing (KProxy :: KProxy d)) + of { + GHC.Tuple.(,,,) (SomeSing c) (SomeSing c) (SomeSing c) (SomeSing c) + -> SomeSing (SC c c c c) } + toSing (D b b b b) + = case + GHC.Tuple.(,,,) + (toSing b :: SomeSing (KProxy :: KProxy a)) + (toSing b :: SomeSing (KProxy :: KProxy b)) + (toSing b :: SomeSing (KProxy :: KProxy c)) + (toSing b :: SomeSing (KProxy :: KProxy d)) + of { + GHC.Tuple.(,,,) (SomeSing c) (SomeSing c) (SomeSing c) (SomeSing c) + -> SomeSing (SD c c c c) } + toSing (E b b b b) + = case + GHC.Tuple.(,,,) + (toSing b :: SomeSing (KProxy :: KProxy a)) + (toSing b :: SomeSing (KProxy :: KProxy b)) + (toSing b :: SomeSing (KProxy :: KProxy c)) + (toSing b :: SomeSing (KProxy :: KProxy d)) + of { + GHC.Tuple.(,,,) (SomeSing c) (SomeSing c) (SomeSing c) (SomeSing c) + -> SomeSing (SE c c c c) } + toSing (F b b b b) + = case + GHC.Tuple.(,,,) + (toSing b :: SomeSing (KProxy :: KProxy a)) + (toSing b :: SomeSing (KProxy :: KProxy b)) + (toSing b :: SomeSing (KProxy :: KProxy c)) + (toSing b :: SomeSing (KProxy :: KProxy d)) + of { + GHC.Tuple.(,,,) (SomeSing c) (SomeSing c) (SomeSing c) (SomeSing c) + -> SomeSing (SF c c c c) } + instance (SEq (KProxy :: KProxy a), + SEq (KProxy :: KProxy b), + SEq (KProxy :: KProxy c), + SEq (KProxy :: KProxy d)) => + SEq (KProxy :: KProxy (Foo a b c d)) where + (%:==) (SA a a a a) (SA b b b b) + = (%:&&) + ((%:==) a b) + ((%:&&) ((%:==) a b) ((%:&&) ((%:==) a b) ((%:==) a b))) + (%:==) (SA _ _ _ _) (SB _ _ _ _) = SFalse + (%:==) (SA _ _ _ _) (SC _ _ _ _) = SFalse + (%:==) (SA _ _ _ _) (SD _ _ _ _) = SFalse + (%:==) (SA _ _ _ _) (SE _ _ _ _) = SFalse + (%:==) (SA _ _ _ _) (SF _ _ _ _) = SFalse + (%:==) (SB _ _ _ _) (SA _ _ _ _) = SFalse + (%:==) (SB a a a a) (SB b b b b) + = (%:&&) + ((%:==) a b) + ((%:&&) ((%:==) a b) ((%:&&) ((%:==) a b) ((%:==) a b))) + (%:==) (SB _ _ _ _) (SC _ _ _ _) = SFalse + (%:==) (SB _ _ _ _) (SD _ _ _ _) = SFalse + (%:==) (SB _ _ _ _) (SE _ _ _ _) = SFalse + (%:==) (SB _ _ _ _) (SF _ _ _ _) = SFalse + (%:==) (SC _ _ _ _) (SA _ _ _ _) = SFalse + (%:==) (SC _ _ _ _) (SB _ _ _ _) = SFalse + (%:==) (SC a a a a) (SC b b b b) + = (%:&&) + ((%:==) a b) + ((%:&&) ((%:==) a b) ((%:&&) ((%:==) a b) ((%:==) a b))) + (%:==) (SC _ _ _ _) (SD _ _ _ _) = SFalse + (%:==) (SC _ _ _ _) (SE _ _ _ _) = SFalse + (%:==) (SC _ _ _ _) (SF _ _ _ _) = SFalse + (%:==) (SD _ _ _ _) (SA _ _ _ _) = SFalse + (%:==) (SD _ _ _ _) (SB _ _ _ _) = SFalse + (%:==) (SD _ _ _ _) (SC _ _ _ _) = SFalse + (%:==) (SD a a a a) (SD b b b b) + = (%:&&) + ((%:==) a b) + ((%:&&) ((%:==) a b) ((%:&&) ((%:==) a b) ((%:==) a b))) + (%:==) (SD _ _ _ _) (SE _ _ _ _) = SFalse + (%:==) (SD _ _ _ _) (SF _ _ _ _) = SFalse + (%:==) (SE _ _ _ _) (SA _ _ _ _) = SFalse + (%:==) (SE _ _ _ _) (SB _ _ _ _) = SFalse + (%:==) (SE _ _ _ _) (SC _ _ _ _) = SFalse + (%:==) (SE _ _ _ _) (SD _ _ _ _) = SFalse + (%:==) (SE a a a a) (SE b b b b) + = (%:&&) + ((%:==) a b) + ((%:&&) ((%:==) a b) ((%:&&) ((%:==) a b) ((%:==) a b))) + (%:==) (SE _ _ _ _) (SF _ _ _ _) = SFalse + (%:==) (SF _ _ _ _) (SA _ _ _ _) = SFalse + (%:==) (SF _ _ _ _) (SB _ _ _ _) = SFalse + (%:==) (SF _ _ _ _) (SC _ _ _ _) = SFalse + (%:==) (SF _ _ _ _) (SD _ _ _ _) = SFalse + (%:==) (SF _ _ _ _) (SE _ _ _ _) = SFalse + (%:==) (SF a a a a) (SF b b b b) + = (%:&&) + ((%:==) a b) + ((%:&&) ((%:==) a b) ((%:&&) ((%:==) a b) ((%:==) a b))) + instance (SDecide (KProxy :: KProxy a), + SDecide (KProxy :: KProxy b), + SDecide (KProxy :: KProxy c), + SDecide (KProxy :: KProxy d)) => + SDecide (KProxy :: KProxy (Foo a b c d)) where + (%~) (SA a a a a) (SA b b b b) + = case + GHC.Tuple.(,,,) ((%~) a b) ((%~) a b) ((%~) a b) ((%~) a b) + of { + GHC.Tuple.(,,,) (Proved Refl) + (Proved Refl) + (Proved Refl) + (Proved Refl) + -> Proved Refl + GHC.Tuple.(,,,) (Disproved contra) _ _ _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + GHC.Tuple.(,,,) _ (Disproved contra) _ _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + GHC.Tuple.(,,,) _ _ (Disproved contra) _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + GHC.Tuple.(,,,) _ _ _ (Disproved contra) + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) } + (%~) (SA _ _ _ _) (SB _ _ _ _) + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) (SA _ _ _ _) (SC _ _ _ _) + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) (SA _ _ _ _) (SD _ _ _ _) + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) (SA _ _ _ _) (SE _ _ _ _) + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) (SA _ _ _ _) (SF _ _ _ _) + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) (SB _ _ _ _) (SA _ _ _ _) + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) (SB a a a a) (SB b b b b) + = case + GHC.Tuple.(,,,) ((%~) a b) ((%~) a b) ((%~) a b) ((%~) a b) + of { + GHC.Tuple.(,,,) (Proved Refl) + (Proved Refl) + (Proved Refl) + (Proved Refl) + -> Proved Refl + GHC.Tuple.(,,,) (Disproved contra) _ _ _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + GHC.Tuple.(,,,) _ (Disproved contra) _ _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + GHC.Tuple.(,,,) _ _ (Disproved contra) _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + GHC.Tuple.(,,,) _ _ _ (Disproved contra) + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) } + (%~) (SB _ _ _ _) (SC _ _ _ _) + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) (SB _ _ _ _) (SD _ _ _ _) + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) (SB _ _ _ _) (SE _ _ _ _) + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) (SB _ _ _ _) (SF _ _ _ _) + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) (SC _ _ _ _) (SA _ _ _ _) + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) (SC _ _ _ _) (SB _ _ _ _) + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) (SC a a a a) (SC b b b b) + = case + GHC.Tuple.(,,,) ((%~) a b) ((%~) a b) ((%~) a b) ((%~) a b) + of { + GHC.Tuple.(,,,) (Proved Refl) + (Proved Refl) + (Proved Refl) + (Proved Refl) + -> Proved Refl + GHC.Tuple.(,,,) (Disproved contra) _ _ _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + GHC.Tuple.(,,,) _ (Disproved contra) _ _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + GHC.Tuple.(,,,) _ _ (Disproved contra) _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + GHC.Tuple.(,,,) _ _ _ (Disproved contra) + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) } + (%~) (SC _ _ _ _) (SD _ _ _ _) + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) (SC _ _ _ _) (SE _ _ _ _) + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) (SC _ _ _ _) (SF _ _ _ _) + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) (SD _ _ _ _) (SA _ _ _ _) + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) (SD _ _ _ _) (SB _ _ _ _) + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) (SD _ _ _ _) (SC _ _ _ _) + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) (SD a a a a) (SD b b b b) + = case + GHC.Tuple.(,,,) ((%~) a b) ((%~) a b) ((%~) a b) ((%~) a b) + of { + GHC.Tuple.(,,,) (Proved Refl) + (Proved Refl) + (Proved Refl) + (Proved Refl) + -> Proved Refl + GHC.Tuple.(,,,) (Disproved contra) _ _ _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + GHC.Tuple.(,,,) _ (Disproved contra) _ _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + GHC.Tuple.(,,,) _ _ (Disproved contra) _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + GHC.Tuple.(,,,) _ _ _ (Disproved contra) + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) } + (%~) (SD _ _ _ _) (SE _ _ _ _) + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) (SD _ _ _ _) (SF _ _ _ _) + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) (SE _ _ _ _) (SA _ _ _ _) + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) (SE _ _ _ _) (SB _ _ _ _) + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) (SE _ _ _ _) (SC _ _ _ _) + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) (SE _ _ _ _) (SD _ _ _ _) + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) (SE a a a a) (SE b b b b) + = case + GHC.Tuple.(,,,) ((%~) a b) ((%~) a b) ((%~) a b) ((%~) a b) + of { + GHC.Tuple.(,,,) (Proved Refl) + (Proved Refl) + (Proved Refl) + (Proved Refl) + -> Proved Refl + GHC.Tuple.(,,,) (Disproved contra) _ _ _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + GHC.Tuple.(,,,) _ (Disproved contra) _ _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + GHC.Tuple.(,,,) _ _ (Disproved contra) _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + GHC.Tuple.(,,,) _ _ _ (Disproved contra) + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) } + (%~) (SE _ _ _ _) (SF _ _ _ _) + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) (SF _ _ _ _) (SA _ _ _ _) + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) (SF _ _ _ _) (SB _ _ _ _) + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) (SF _ _ _ _) (SC _ _ _ _) + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) (SF _ _ _ _) (SD _ _ _ _) + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) (SF _ _ _ _) (SE _ _ _ _) + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) (SF a a a a) (SF b b b b) + = case + GHC.Tuple.(,,,) ((%~) a b) ((%~) a b) ((%~) a b) ((%~) a b) + of { + GHC.Tuple.(,,,) (Proved Refl) + (Proved Refl) + (Proved Refl) + (Proved Refl) + -> Proved Refl + GHC.Tuple.(,,,) (Disproved contra) _ _ _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + GHC.Tuple.(,,,) _ (Disproved contra) _ _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + GHC.Tuple.(,,,) _ _ (Disproved contra) _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + GHC.Tuple.(,,,) _ _ _ (Disproved contra) + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) } + instance SOrd (KProxy :: KProxy Nat) => + SOrd (KProxy :: KProxy Nat) where + sCompare :: + forall (t0 :: Nat) (t1 :: Nat). + Sing t0 + -> Sing t1 + -> Sing (Apply (Apply (CompareSym0 :: TyFun Nat (TyFun Nat Ordering + -> GHC.Types.Type) + -> GHC.Types.Type) t0 :: TyFun Nat Ordering + -> GHC.Types.Type) t1 :: Ordering) + sCompare SZero SZero + = let + lambda :: + (t0 ~ ZeroSym0, t1 ~ ZeroSym0) => + Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda + = applySing + (applySing + (applySing + (singFun3 (Proxy :: Proxy FoldlSym0) sFoldl) + (singFun2 (Proxy :: Proxy ThenCmpSym0) sThenCmp)) + SEQ) + SNil + in lambda + sCompare (SSucc sA_0123456789) (SSucc sB_0123456789) + = let + lambda :: + forall a_0123456789 b_0123456789. + (t0 ~ Apply SuccSym0 a_0123456789, + t1 ~ Apply SuccSym0 b_0123456789) => + Sing a_0123456789 + -> Sing b_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda a_0123456789 b_0123456789 + = applySing + (applySing + (applySing + (singFun3 (Proxy :: Proxy FoldlSym0) sFoldl) + (singFun2 (Proxy :: Proxy ThenCmpSym0) sThenCmp)) + SEQ) + (applySing + (applySing + (singFun2 (Proxy :: Proxy (:$)) SCons) + (applySing + (applySing + (singFun2 (Proxy :: Proxy CompareSym0) sCompare) a_0123456789) + b_0123456789)) + SNil) + in lambda sA_0123456789 sB_0123456789 + sCompare SZero (SSucc _s_z_0123456789) + = let + lambda :: + forall _z_0123456789. + (t0 ~ ZeroSym0, t1 ~ Apply SuccSym0 _z_0123456789) => + Sing _z_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda _z_0123456789 = SLT + in lambda _s_z_0123456789 + sCompare (SSucc _s_z_0123456789) SZero + = let + lambda :: + forall _z_0123456789. + (t0 ~ Apply SuccSym0 _z_0123456789, t1 ~ ZeroSym0) => + Sing _z_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda _z_0123456789 = SGT + in lambda _s_z_0123456789 + instance (SOrd (KProxy :: KProxy a), + SOrd (KProxy :: KProxy b), + SOrd (KProxy :: KProxy c), + SOrd (KProxy :: KProxy d)) => + SOrd (KProxy :: KProxy (Foo a b c d)) where + sCompare :: + forall (t0 :: Foo a b c d) (t1 :: Foo a b c d). + Sing t0 + -> Sing t1 + -> Sing (Apply (Apply (CompareSym0 :: TyFun (Foo a b c d) (TyFun (Foo a b c d) Ordering + -> GHC.Types.Type) + -> GHC.Types.Type) t0 :: TyFun (Foo a b c d) Ordering + -> GHC.Types.Type) t1 :: Ordering) + sCompare + (SA sA_0123456789 sA_0123456789 sA_0123456789 sA_0123456789) + (SA sB_0123456789 sB_0123456789 sB_0123456789 sB_0123456789) + = let + lambda :: + forall a_0123456789 + a_0123456789 + a_0123456789 + a_0123456789 + b_0123456789 + b_0123456789 + b_0123456789 + b_0123456789. + (t0 ~ Apply (Apply (Apply (Apply ASym0 a_0123456789) a_0123456789) a_0123456789) a_0123456789, + t1 ~ Apply (Apply (Apply (Apply ASym0 b_0123456789) b_0123456789) b_0123456789) b_0123456789) => + Sing a_0123456789 + -> Sing a_0123456789 + -> Sing a_0123456789 + -> Sing a_0123456789 + -> Sing b_0123456789 + -> Sing b_0123456789 + -> Sing b_0123456789 + -> Sing b_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda + a_0123456789 + a_0123456789 + a_0123456789 + a_0123456789 + b_0123456789 + b_0123456789 + b_0123456789 + b_0123456789 + = applySing + (applySing + (applySing + (singFun3 (Proxy :: Proxy FoldlSym0) sFoldl) + (singFun2 (Proxy :: Proxy ThenCmpSym0) sThenCmp)) + SEQ) + (applySing + (applySing + (singFun2 (Proxy :: Proxy (:$)) SCons) + (applySing + (applySing + (singFun2 (Proxy :: Proxy CompareSym0) sCompare) a_0123456789) + b_0123456789)) + (applySing + (applySing + (singFun2 (Proxy :: Proxy (:$)) SCons) + (applySing + (applySing + (singFun2 (Proxy :: Proxy CompareSym0) sCompare) a_0123456789) + b_0123456789)) + (applySing + (applySing + (singFun2 (Proxy :: Proxy (:$)) SCons) + (applySing + (applySing + (singFun2 (Proxy :: Proxy CompareSym0) sCompare) a_0123456789) + b_0123456789)) + (applySing + (applySing + (singFun2 (Proxy :: Proxy (:$)) SCons) + (applySing + (applySing + (singFun2 (Proxy :: Proxy CompareSym0) sCompare) + a_0123456789) + b_0123456789)) + SNil)))) + in + lambda + sA_0123456789 + sA_0123456789 + sA_0123456789 + sA_0123456789 + sB_0123456789 + sB_0123456789 + sB_0123456789 + sB_0123456789 + sCompare + (SB sA_0123456789 sA_0123456789 sA_0123456789 sA_0123456789) + (SB sB_0123456789 sB_0123456789 sB_0123456789 sB_0123456789) + = let + lambda :: + forall a_0123456789 + a_0123456789 + a_0123456789 + a_0123456789 + b_0123456789 + b_0123456789 + b_0123456789 + b_0123456789. + (t0 ~ Apply (Apply (Apply (Apply BSym0 a_0123456789) a_0123456789) a_0123456789) a_0123456789, + t1 ~ Apply (Apply (Apply (Apply BSym0 b_0123456789) b_0123456789) b_0123456789) b_0123456789) => + Sing a_0123456789 + -> Sing a_0123456789 + -> Sing a_0123456789 + -> Sing a_0123456789 + -> Sing b_0123456789 + -> Sing b_0123456789 + -> Sing b_0123456789 + -> Sing b_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda + a_0123456789 + a_0123456789 + a_0123456789 + a_0123456789 + b_0123456789 + b_0123456789 + b_0123456789 + b_0123456789 + = applySing + (applySing + (applySing + (singFun3 (Proxy :: Proxy FoldlSym0) sFoldl) + (singFun2 (Proxy :: Proxy ThenCmpSym0) sThenCmp)) + SEQ) + (applySing + (applySing + (singFun2 (Proxy :: Proxy (:$)) SCons) + (applySing + (applySing + (singFun2 (Proxy :: Proxy CompareSym0) sCompare) a_0123456789) + b_0123456789)) + (applySing + (applySing + (singFun2 (Proxy :: Proxy (:$)) SCons) + (applySing + (applySing + (singFun2 (Proxy :: Proxy CompareSym0) sCompare) a_0123456789) + b_0123456789)) + (applySing + (applySing + (singFun2 (Proxy :: Proxy (:$)) SCons) + (applySing + (applySing + (singFun2 (Proxy :: Proxy CompareSym0) sCompare) a_0123456789) + b_0123456789)) + (applySing + (applySing + (singFun2 (Proxy :: Proxy (:$)) SCons) + (applySing + (applySing + (singFun2 (Proxy :: Proxy CompareSym0) sCompare) + a_0123456789) + b_0123456789)) + SNil)))) + in + lambda + sA_0123456789 + sA_0123456789 + sA_0123456789 + sA_0123456789 + sB_0123456789 + sB_0123456789 + sB_0123456789 + sB_0123456789 + sCompare + (SC sA_0123456789 sA_0123456789 sA_0123456789 sA_0123456789) + (SC sB_0123456789 sB_0123456789 sB_0123456789 sB_0123456789) + = let + lambda :: + forall a_0123456789 + a_0123456789 + a_0123456789 + a_0123456789 + b_0123456789 + b_0123456789 + b_0123456789 + b_0123456789. + (t0 ~ Apply (Apply (Apply (Apply CSym0 a_0123456789) a_0123456789) a_0123456789) a_0123456789, + t1 ~ Apply (Apply (Apply (Apply CSym0 b_0123456789) b_0123456789) b_0123456789) b_0123456789) => + Sing a_0123456789 + -> Sing a_0123456789 + -> Sing a_0123456789 + -> Sing a_0123456789 + -> Sing b_0123456789 + -> Sing b_0123456789 + -> Sing b_0123456789 + -> Sing b_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda + a_0123456789 + a_0123456789 + a_0123456789 + a_0123456789 + b_0123456789 + b_0123456789 + b_0123456789 + b_0123456789 + = applySing + (applySing + (applySing + (singFun3 (Proxy :: Proxy FoldlSym0) sFoldl) + (singFun2 (Proxy :: Proxy ThenCmpSym0) sThenCmp)) + SEQ) + (applySing + (applySing + (singFun2 (Proxy :: Proxy (:$)) SCons) + (applySing + (applySing + (singFun2 (Proxy :: Proxy CompareSym0) sCompare) a_0123456789) + b_0123456789)) + (applySing + (applySing + (singFun2 (Proxy :: Proxy (:$)) SCons) + (applySing + (applySing + (singFun2 (Proxy :: Proxy CompareSym0) sCompare) a_0123456789) + b_0123456789)) + (applySing + (applySing + (singFun2 (Proxy :: Proxy (:$)) SCons) + (applySing + (applySing + (singFun2 (Proxy :: Proxy CompareSym0) sCompare) a_0123456789) + b_0123456789)) + (applySing + (applySing + (singFun2 (Proxy :: Proxy (:$)) SCons) + (applySing + (applySing + (singFun2 (Proxy :: Proxy CompareSym0) sCompare) + a_0123456789) + b_0123456789)) + SNil)))) + in + lambda + sA_0123456789 + sA_0123456789 + sA_0123456789 + sA_0123456789 + sB_0123456789 + sB_0123456789 + sB_0123456789 + sB_0123456789 + sCompare + (SD sA_0123456789 sA_0123456789 sA_0123456789 sA_0123456789) + (SD sB_0123456789 sB_0123456789 sB_0123456789 sB_0123456789) + = let + lambda :: + forall a_0123456789 + a_0123456789 + a_0123456789 + a_0123456789 + b_0123456789 + b_0123456789 + b_0123456789 + b_0123456789. + (t0 ~ Apply (Apply (Apply (Apply DSym0 a_0123456789) a_0123456789) a_0123456789) a_0123456789, + t1 ~ Apply (Apply (Apply (Apply DSym0 b_0123456789) b_0123456789) b_0123456789) b_0123456789) => + Sing a_0123456789 + -> Sing a_0123456789 + -> Sing a_0123456789 + -> Sing a_0123456789 + -> Sing b_0123456789 + -> Sing b_0123456789 + -> Sing b_0123456789 + -> Sing b_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda + a_0123456789 + a_0123456789 + a_0123456789 + a_0123456789 + b_0123456789 + b_0123456789 + b_0123456789 + b_0123456789 + = applySing + (applySing + (applySing + (singFun3 (Proxy :: Proxy FoldlSym0) sFoldl) + (singFun2 (Proxy :: Proxy ThenCmpSym0) sThenCmp)) + SEQ) + (applySing + (applySing + (singFun2 (Proxy :: Proxy (:$)) SCons) + (applySing + (applySing + (singFun2 (Proxy :: Proxy CompareSym0) sCompare) a_0123456789) + b_0123456789)) + (applySing + (applySing + (singFun2 (Proxy :: Proxy (:$)) SCons) + (applySing + (applySing + (singFun2 (Proxy :: Proxy CompareSym0) sCompare) a_0123456789) + b_0123456789)) + (applySing + (applySing + (singFun2 (Proxy :: Proxy (:$)) SCons) + (applySing + (applySing + (singFun2 (Proxy :: Proxy CompareSym0) sCompare) a_0123456789) + b_0123456789)) + (applySing + (applySing + (singFun2 (Proxy :: Proxy (:$)) SCons) + (applySing + (applySing + (singFun2 (Proxy :: Proxy CompareSym0) sCompare) + a_0123456789) + b_0123456789)) + SNil)))) + in + lambda + sA_0123456789 + sA_0123456789 + sA_0123456789 + sA_0123456789 + sB_0123456789 + sB_0123456789 + sB_0123456789 + sB_0123456789 + sCompare + (SE sA_0123456789 sA_0123456789 sA_0123456789 sA_0123456789) + (SE sB_0123456789 sB_0123456789 sB_0123456789 sB_0123456789) + = let + lambda :: + forall a_0123456789 + a_0123456789 + a_0123456789 + a_0123456789 + b_0123456789 + b_0123456789 + b_0123456789 + b_0123456789. + (t0 ~ Apply (Apply (Apply (Apply ESym0 a_0123456789) a_0123456789) a_0123456789) a_0123456789, + t1 ~ Apply (Apply (Apply (Apply ESym0 b_0123456789) b_0123456789) b_0123456789) b_0123456789) => + Sing a_0123456789 + -> Sing a_0123456789 + -> Sing a_0123456789 + -> Sing a_0123456789 + -> Sing b_0123456789 + -> Sing b_0123456789 + -> Sing b_0123456789 + -> Sing b_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda + a_0123456789 + a_0123456789 + a_0123456789 + a_0123456789 + b_0123456789 + b_0123456789 + b_0123456789 + b_0123456789 + = applySing + (applySing + (applySing + (singFun3 (Proxy :: Proxy FoldlSym0) sFoldl) + (singFun2 (Proxy :: Proxy ThenCmpSym0) sThenCmp)) + SEQ) + (applySing + (applySing + (singFun2 (Proxy :: Proxy (:$)) SCons) + (applySing + (applySing + (singFun2 (Proxy :: Proxy CompareSym0) sCompare) a_0123456789) + b_0123456789)) + (applySing + (applySing + (singFun2 (Proxy :: Proxy (:$)) SCons) + (applySing + (applySing + (singFun2 (Proxy :: Proxy CompareSym0) sCompare) a_0123456789) + b_0123456789)) + (applySing + (applySing + (singFun2 (Proxy :: Proxy (:$)) SCons) + (applySing + (applySing + (singFun2 (Proxy :: Proxy CompareSym0) sCompare) a_0123456789) + b_0123456789)) + (applySing + (applySing + (singFun2 (Proxy :: Proxy (:$)) SCons) + (applySing + (applySing + (singFun2 (Proxy :: Proxy CompareSym0) sCompare) + a_0123456789) + b_0123456789)) + SNil)))) + in + lambda + sA_0123456789 + sA_0123456789 + sA_0123456789 + sA_0123456789 + sB_0123456789 + sB_0123456789 + sB_0123456789 + sB_0123456789 + sCompare + (SF sA_0123456789 sA_0123456789 sA_0123456789 sA_0123456789) + (SF sB_0123456789 sB_0123456789 sB_0123456789 sB_0123456789) + = let + lambda :: + forall a_0123456789 + a_0123456789 + a_0123456789 + a_0123456789 + b_0123456789 + b_0123456789 + b_0123456789 + b_0123456789. + (t0 ~ Apply (Apply (Apply (Apply FSym0 a_0123456789) a_0123456789) a_0123456789) a_0123456789, + t1 ~ Apply (Apply (Apply (Apply FSym0 b_0123456789) b_0123456789) b_0123456789) b_0123456789) => + Sing a_0123456789 + -> Sing a_0123456789 + -> Sing a_0123456789 + -> Sing a_0123456789 + -> Sing b_0123456789 + -> Sing b_0123456789 + -> Sing b_0123456789 + -> Sing b_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda + a_0123456789 + a_0123456789 + a_0123456789 + a_0123456789 + b_0123456789 + b_0123456789 + b_0123456789 + b_0123456789 + = applySing + (applySing + (applySing + (singFun3 (Proxy :: Proxy FoldlSym0) sFoldl) + (singFun2 (Proxy :: Proxy ThenCmpSym0) sThenCmp)) + SEQ) + (applySing + (applySing + (singFun2 (Proxy :: Proxy (:$)) SCons) + (applySing + (applySing + (singFun2 (Proxy :: Proxy CompareSym0) sCompare) a_0123456789) + b_0123456789)) + (applySing + (applySing + (singFun2 (Proxy :: Proxy (:$)) SCons) + (applySing + (applySing + (singFun2 (Proxy :: Proxy CompareSym0) sCompare) a_0123456789) + b_0123456789)) + (applySing + (applySing + (singFun2 (Proxy :: Proxy (:$)) SCons) + (applySing + (applySing + (singFun2 (Proxy :: Proxy CompareSym0) sCompare) a_0123456789) + b_0123456789)) + (applySing + (applySing + (singFun2 (Proxy :: Proxy (:$)) SCons) + (applySing + (applySing + (singFun2 (Proxy :: Proxy CompareSym0) sCompare) + a_0123456789) + b_0123456789)) + SNil)))) + in + lambda + sA_0123456789 + sA_0123456789 + sA_0123456789 + sA_0123456789 + sB_0123456789 + sB_0123456789 + sB_0123456789 + sB_0123456789 + sCompare + (SA _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + (SB _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + = let + lambda :: + forall _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789. + (t0 ~ Apply (Apply (Apply (Apply ASym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789, + t1 ~ Apply (Apply (Apply (Apply BSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) => + Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + = SLT + in + lambda + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + sCompare + (SA _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + (SC _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + = let + lambda :: + forall _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789. + (t0 ~ Apply (Apply (Apply (Apply ASym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789, + t1 ~ Apply (Apply (Apply (Apply CSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) => + Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + = SLT + in + lambda + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + sCompare + (SA _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + (SD _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + = let + lambda :: + forall _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789. + (t0 ~ Apply (Apply (Apply (Apply ASym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789, + t1 ~ Apply (Apply (Apply (Apply DSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) => + Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + = SLT + in + lambda + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + sCompare + (SA _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + (SE _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + = let + lambda :: + forall _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789. + (t0 ~ Apply (Apply (Apply (Apply ASym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789, + t1 ~ Apply (Apply (Apply (Apply ESym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) => + Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + = SLT + in + lambda + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + sCompare + (SA _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + (SF _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + = let + lambda :: + forall _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789. + (t0 ~ Apply (Apply (Apply (Apply ASym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789, + t1 ~ Apply (Apply (Apply (Apply FSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) => + Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + = SLT + in + lambda + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + sCompare + (SB _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + (SA _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + = let + lambda :: + forall _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789. + (t0 ~ Apply (Apply (Apply (Apply BSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789, + t1 ~ Apply (Apply (Apply (Apply ASym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) => + Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + = SGT + in + lambda + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + sCompare + (SB _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + (SC _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + = let + lambda :: + forall _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789. + (t0 ~ Apply (Apply (Apply (Apply BSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789, + t1 ~ Apply (Apply (Apply (Apply CSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) => + Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + = SLT + in + lambda + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + sCompare + (SB _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + (SD _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + = let + lambda :: + forall _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789. + (t0 ~ Apply (Apply (Apply (Apply BSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789, + t1 ~ Apply (Apply (Apply (Apply DSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) => + Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + = SLT + in + lambda + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + sCompare + (SB _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + (SE _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + = let + lambda :: + forall _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789. + (t0 ~ Apply (Apply (Apply (Apply BSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789, + t1 ~ Apply (Apply (Apply (Apply ESym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) => + Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + = SLT + in + lambda + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + sCompare + (SB _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + (SF _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + = let + lambda :: + forall _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789. + (t0 ~ Apply (Apply (Apply (Apply BSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789, + t1 ~ Apply (Apply (Apply (Apply FSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) => + Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + = SLT + in + lambda + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + sCompare + (SC _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + (SA _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + = let + lambda :: + forall _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789. + (t0 ~ Apply (Apply (Apply (Apply CSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789, + t1 ~ Apply (Apply (Apply (Apply ASym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) => + Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + = SGT + in + lambda + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + sCompare + (SC _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + (SB _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + = let + lambda :: + forall _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789. + (t0 ~ Apply (Apply (Apply (Apply CSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789, + t1 ~ Apply (Apply (Apply (Apply BSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) => + Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + = SGT + in + lambda + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + sCompare + (SC _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + (SD _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + = let + lambda :: + forall _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789. + (t0 ~ Apply (Apply (Apply (Apply CSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789, + t1 ~ Apply (Apply (Apply (Apply DSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) => + Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + = SLT + in + lambda + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + sCompare + (SC _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + (SE _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + = let + lambda :: + forall _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789. + (t0 ~ Apply (Apply (Apply (Apply CSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789, + t1 ~ Apply (Apply (Apply (Apply ESym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) => + Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + = SLT + in + lambda + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + sCompare + (SC _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + (SF _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + = let + lambda :: + forall _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789. + (t0 ~ Apply (Apply (Apply (Apply CSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789, + t1 ~ Apply (Apply (Apply (Apply FSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) => + Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + = SLT + in + lambda + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + sCompare + (SD _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + (SA _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + = let + lambda :: + forall _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789. + (t0 ~ Apply (Apply (Apply (Apply DSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789, + t1 ~ Apply (Apply (Apply (Apply ASym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) => + Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + = SGT + in + lambda + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + sCompare + (SD _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + (SB _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + = let + lambda :: + forall _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789. + (t0 ~ Apply (Apply (Apply (Apply DSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789, + t1 ~ Apply (Apply (Apply (Apply BSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) => + Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + = SGT + in + lambda + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + sCompare + (SD _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + (SC _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + = let + lambda :: + forall _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789. + (t0 ~ Apply (Apply (Apply (Apply DSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789, + t1 ~ Apply (Apply (Apply (Apply CSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) => + Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + = SGT + in + lambda + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + sCompare + (SD _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + (SE _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + = let + lambda :: + forall _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789. + (t0 ~ Apply (Apply (Apply (Apply DSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789, + t1 ~ Apply (Apply (Apply (Apply ESym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) => + Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + = SLT + in + lambda + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + sCompare + (SD _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + (SF _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + = let + lambda :: + forall _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789. + (t0 ~ Apply (Apply (Apply (Apply DSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789, + t1 ~ Apply (Apply (Apply (Apply FSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) => + Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + = SLT + in + lambda + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + sCompare + (SE _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + (SA _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + = let + lambda :: + forall _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789. + (t0 ~ Apply (Apply (Apply (Apply ESym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789, + t1 ~ Apply (Apply (Apply (Apply ASym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) => + Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + = SGT + in + lambda + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + sCompare + (SE _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + (SB _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + = let + lambda :: + forall _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789. + (t0 ~ Apply (Apply (Apply (Apply ESym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789, + t1 ~ Apply (Apply (Apply (Apply BSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) => + Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + = SGT + in + lambda + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + sCompare + (SE _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + (SC _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + = let + lambda :: + forall _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789. + (t0 ~ Apply (Apply (Apply (Apply ESym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789, + t1 ~ Apply (Apply (Apply (Apply CSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) => + Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + = SGT + in + lambda + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + sCompare + (SE _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + (SD _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + = let + lambda :: + forall _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789. + (t0 ~ Apply (Apply (Apply (Apply ESym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789, + t1 ~ Apply (Apply (Apply (Apply DSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) => + Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + = SGT + in + lambda + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + sCompare + (SE _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + (SF _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + = let + lambda :: + forall _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789. + (t0 ~ Apply (Apply (Apply (Apply ESym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789, + t1 ~ Apply (Apply (Apply (Apply FSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) => + Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + = SLT + in + lambda + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + sCompare + (SF _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + (SA _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + = let + lambda :: + forall _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789. + (t0 ~ Apply (Apply (Apply (Apply FSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789, + t1 ~ Apply (Apply (Apply (Apply ASym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) => + Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + = SGT + in + lambda + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + sCompare + (SF _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + (SB _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + = let + lambda :: + forall _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789. + (t0 ~ Apply (Apply (Apply (Apply FSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789, + t1 ~ Apply (Apply (Apply (Apply BSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) => + Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + = SGT + in + lambda + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + sCompare + (SF _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + (SC _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + = let + lambda :: + forall _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789. + (t0 ~ Apply (Apply (Apply (Apply FSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789, + t1 ~ Apply (Apply (Apply (Apply CSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) => + Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + = SGT + in + lambda + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + sCompare + (SF _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + (SD _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + = let + lambda :: + forall _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789. + (t0 ~ Apply (Apply (Apply (Apply FSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789, + t1 ~ Apply (Apply (Apply (Apply DSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) => + Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + = SGT + in + lambda + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + sCompare + (SF _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + (SE _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789) + = let + lambda :: + forall _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789. + (t0 ~ Apply (Apply (Apply (Apply FSym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789, + t1 ~ Apply (Apply (Apply (Apply ESym0 _z_0123456789) _z_0123456789) _z_0123456789) _z_0123456789) => + Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + _z_0123456789 + = SGT + in + lambda + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + _s_z_0123456789 + instance SingI Zero where + sing = SZero + instance SingI n => SingI (Succ (n :: Nat)) where + sing = SSucc sing + instance (SingI n, SingI n, SingI n, SingI n) => + SingI (A (n :: a) (n :: b) (n :: c) (n :: d)) where + sing = SA sing sing sing sing + instance (SingI n, SingI n, SingI n, SingI n) => + SingI (B (n :: a) (n :: b) (n :: c) (n :: d)) where + sing = SB sing sing sing sing + instance (SingI n, SingI n, SingI n, SingI n) => + SingI (C (n :: a) (n :: b) (n :: c) (n :: d)) where + sing = SC sing sing sing sing + instance (SingI n, SingI n, SingI n, SingI n) => + SingI (D (n :: a) (n :: b) (n :: c) (n :: d)) where + sing = SD sing sing sing sing + instance (SingI n, SingI n, SingI n, SingI n) => + SingI (E (n :: a) (n :: b) (n :: c) (n :: d)) where + sing = SE sing sing sing sing + instance (SingI n, SingI n, SingI n, SingI n) => + SingI (F (n :: a) (n :: b) (n :: c) (n :: d)) where + sing = SF sing sing sing sing diff --git a/tests/compile-and-dump/Singletons/PatternMatching.ghc710.template b/tests/compile-and-dump/Singletons/PatternMatching.ghc710.template --- a/tests/compile-and-dump/Singletons/PatternMatching.ghc710.template +++ b/tests/compile-and-dump/Singletons/PatternMatching.ghc710.template @@ -16,18 +16,20 @@ complex = Pair (Pair (Just Zero) Zero) False tuple = (False, Just Zero, True) aList = [Zero, Succ Zero, Succ (Succ Zero)] - type PairSym2 (t :: a) (t :: b) = Pair t t + type PairSym2 (t :: a0123456789) (t :: b0123456789) = Pair t t instance SuppressUnusedWarnings PairSym1 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) PairSym1KindInference GHC.Tuple.()) - data PairSym1 (l :: a) (l :: TyFun b (Pair a b)) + data PairSym1 (l :: a0123456789) + (l :: TyFun b0123456789 (Pair a0123456789 b0123456789)) = forall arg. KindOf (Apply (PairSym1 l) arg) ~ KindOf (PairSym2 l arg) => PairSym1KindInference type instance Apply (PairSym1 l) l = PairSym2 l l instance SuppressUnusedWarnings PairSym0 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) PairSym0KindInference GHC.Tuple.()) - data PairSym0 (l :: TyFun a (TyFun b (Pair a b) -> *)) + data PairSym0 (l :: TyFun a0123456789 (TyFun b0123456789 (Pair a0123456789 b0123456789) + -> *)) = forall arg. KindOf (Apply PairSym0 arg) ~ KindOf (PairSym1 arg) => PairSym0KindInference type instance Apply PairSym0 l = PairSym1 l @@ -129,19 +131,6 @@ foo2 t@(# x, y #) = case t of { (# a, b #) -> \ _ -> a b } silly :: forall a. a -> () silly x = case x of { _ -> GHC.Tuple.() } - type Let0123456789Scrutinee_0123456789Sym1 t = - Let0123456789Scrutinee_0123456789 t - instance SuppressUnusedWarnings Let0123456789Scrutinee_0123456789Sym0 where - suppressUnusedWarnings _ - = snd - (GHC.Tuple.(,) - Let0123456789Scrutinee_0123456789Sym0KindInference GHC.Tuple.()) - data Let0123456789Scrutinee_0123456789Sym0 l - = forall arg. KindOf (Apply Let0123456789Scrutinee_0123456789Sym0 arg) ~ KindOf (Let0123456789Scrutinee_0123456789Sym1 arg) => - Let0123456789Scrutinee_0123456789Sym0KindInference - type instance Apply Let0123456789Scrutinee_0123456789Sym0 l = Let0123456789Scrutinee_0123456789Sym1 l - type family Let0123456789Scrutinee_0123456789 x where - Let0123456789Scrutinee_0123456789 x = x type family Case_0123456789 x t where Case_0123456789 x _z_0123456789 = Tuple0Sym0 type Let0123456789TSym2 t t = Let0123456789T t t @@ -161,28 +150,6 @@ type instance Apply Let0123456789TSym0 l = Let0123456789TSym1 l type family Let0123456789T x y where Let0123456789T x y = Apply (Apply Tuple2Sym0 x) y - type Let0123456789Scrutinee_0123456789Sym2 t t = - Let0123456789Scrutinee_0123456789 t t - instance SuppressUnusedWarnings Let0123456789Scrutinee_0123456789Sym1 where - suppressUnusedWarnings _ - = snd - (GHC.Tuple.(,) - Let0123456789Scrutinee_0123456789Sym1KindInference GHC.Tuple.()) - data Let0123456789Scrutinee_0123456789Sym1 l l - = forall arg. KindOf (Apply (Let0123456789Scrutinee_0123456789Sym1 l) arg) ~ KindOf (Let0123456789Scrutinee_0123456789Sym2 l arg) => - Let0123456789Scrutinee_0123456789Sym1KindInference - type instance Apply (Let0123456789Scrutinee_0123456789Sym1 l) l = Let0123456789Scrutinee_0123456789Sym2 l l - instance SuppressUnusedWarnings Let0123456789Scrutinee_0123456789Sym0 where - suppressUnusedWarnings _ - = snd - (GHC.Tuple.(,) - Let0123456789Scrutinee_0123456789Sym0KindInference GHC.Tuple.()) - data Let0123456789Scrutinee_0123456789Sym0 l - = forall arg. KindOf (Apply Let0123456789Scrutinee_0123456789Sym0 arg) ~ KindOf (Let0123456789Scrutinee_0123456789Sym1 arg) => - Let0123456789Scrutinee_0123456789Sym0KindInference - type instance Apply Let0123456789Scrutinee_0123456789Sym0 l = Let0123456789Scrutinee_0123456789Sym1 l - type family Let0123456789Scrutinee_0123456789 x y where - Let0123456789Scrutinee_0123456789 x y = Let0123456789TSym2 x y type family Case_0123456789 x y a b arg_0123456789 t where Case_0123456789 x y a b arg_0123456789 _z_0123456789 = a type family Lambda_0123456789 x y a b t where @@ -290,27 +257,27 @@ Case_0123456789 (Pair y_0123456789 _z_0123456789) = y_0123456789 type family Case_0123456789 t where Case_0123456789 (Pair _z_0123456789 y_0123456789) = y_0123456789 - type SillySym1 (t :: a) = Silly t + type SillySym1 (t :: a0123456789) = Silly t instance SuppressUnusedWarnings SillySym0 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) SillySym0KindInference GHC.Tuple.()) - data SillySym0 (l :: TyFun a ()) + data SillySym0 (l :: TyFun a0123456789 ()) = forall arg. KindOf (Apply SillySym0 arg) ~ KindOf (SillySym1 arg) => SillySym0KindInference type instance Apply SillySym0 l = SillySym1 l - type Foo2Sym1 (t :: (a, b)) = Foo2 t + type Foo2Sym1 (t :: (a0123456789, b0123456789)) = Foo2 t instance SuppressUnusedWarnings Foo2Sym0 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) Foo2Sym0KindInference GHC.Tuple.()) - data Foo2Sym0 (l :: TyFun (a, b) a) + data Foo2Sym0 (l :: TyFun (a0123456789, b0123456789) a0123456789) = forall arg. KindOf (Apply Foo2Sym0 arg) ~ KindOf (Foo2Sym1 arg) => Foo2Sym0KindInference type instance Apply Foo2Sym0 l = Foo2Sym1 l - type Foo1Sym1 (t :: (a, b)) = Foo1 t + type Foo1Sym1 (t :: (a0123456789, b0123456789)) = Foo1 t instance SuppressUnusedWarnings Foo1Sym0 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) Foo1Sym0KindInference GHC.Tuple.()) - data Foo1Sym0 (l :: TyFun (a, b) a) + data Foo1Sym0 (l :: TyFun (a0123456789, b0123456789) a0123456789) = forall arg. KindOf (Apply Foo1Sym0 arg) ~ KindOf (Foo1Sym1 arg) => Foo1Sym0KindInference type instance Apply Foo1Sym0 l = Foo1Sym1 l @@ -329,10 +296,9 @@ type X_0123456789Sym0 = X_0123456789 type X_0123456789Sym0 = X_0123456789 type family Silly (a :: a) :: () where - Silly x = Case_0123456789 x (Let0123456789Scrutinee_0123456789Sym1 x) + Silly x = Case_0123456789 x x type family Foo2 (a :: (a, b)) :: a where - Foo2 '(x, - y) = Case_0123456789 x y (Let0123456789Scrutinee_0123456789Sym2 x y) + Foo2 '(x, y) = Case_0123456789 x y (Let0123456789TSym2 x y) type family Foo1 (a :: (a, b)) :: a where Foo1 '(x, y) = Apply (Apply (Apply Lambda_0123456789Sym0 x) y) y type family Lsz :: Nat where @@ -385,48 +351,38 @@ sSilly sX = let lambda :: - forall x. t ~ x => Sing x -> Sing (Apply SillySym0 x :: ()) + forall x. t ~ x => Sing x -> Sing (Apply SillySym0 t :: ()) lambda x - = let - sScrutinee_0123456789 :: - Sing (Let0123456789Scrutinee_0123456789Sym1 x) - sScrutinee_0123456789 = x - in case sScrutinee_0123456789 of { - _s_z_0123456789 - -> let - lambda :: - forall _z_0123456789. _z_0123456789 ~ Let0123456789Scrutinee_0123456789Sym1 x => - Sing _z_0123456789 -> Sing (Case_0123456789 x _z_0123456789) - lambda _z_0123456789 = STuple0 - in lambda _s_z_0123456789 } :: - Sing (Case_0123456789 x (Let0123456789Scrutinee_0123456789Sym1 x)) + = case x of { + _s_z_0123456789 + -> let + lambda :: + forall _z_0123456789. _z_0123456789 ~ x => + Sing _z_0123456789 -> Sing (Case_0123456789 x _z_0123456789 :: ()) + lambda _z_0123456789 = STuple0 + in lambda _s_z_0123456789 } :: + Sing (Case_0123456789 x x :: ()) in lambda sX sFoo2 (STuple2 sX sY) = let lambda :: forall x y. t ~ Apply (Apply Tuple2Sym0 x) y => - Sing x - -> Sing y - -> Sing (Apply Foo2Sym0 (Apply (Apply Tuple2Sym0 x) y) :: a) + Sing x -> Sing y -> Sing (Apply Foo2Sym0 t :: a) lambda x y = let sT :: Sing (Let0123456789TSym2 x y) sT = applySing - (applySing (singFun2 (Proxy :: Proxy Tuple2Sym0) STuple2) x) y in - let - sScrutinee_0123456789 :: - Sing (Let0123456789Scrutinee_0123456789Sym2 x y) - sScrutinee_0123456789 = sT - in case sScrutinee_0123456789 of { + (applySing (singFun2 (Proxy :: Proxy Tuple2Sym0) STuple2) x) y + in case sT of { STuple2 sA sB -> let lambda :: forall a - b. Apply (Apply Tuple2Sym0 a) b ~ Let0123456789Scrutinee_0123456789Sym2 x y => + b. Apply (Apply Tuple2Sym0 a) b ~ Let0123456789TSym2 x y => Sing a -> Sing b - -> Sing (Case_0123456789 x y (Apply (Apply Tuple2Sym0 a) b)) + -> Sing (Case_0123456789 x y (Apply (Apply Tuple2Sym0 a) b) :: a) lambda a b = applySing (singFun1 @@ -452,15 +408,13 @@ in lambda sArg_0123456789)) b in lambda sA sB } :: - Sing (Case_0123456789 x y (Let0123456789Scrutinee_0123456789Sym2 x y)) + Sing (Case_0123456789 x y (Let0123456789TSym2 x y) :: a) in lambda sX sY sFoo1 (STuple2 sX sY) = let lambda :: forall x y. t ~ Apply (Apply Tuple2Sym0 x) y => - Sing x - -> Sing y - -> Sing (Apply Foo1Sym0 (Apply (Apply Tuple2Sym0 x) y) :: a) + Sing x -> Sing y -> Sing (Apply Foo1Sym0 t :: a) lambda x y = applySing (singFun1 @@ -497,10 +451,10 @@ Sing _z_0123456789 -> Sing y_0123456789 -> Sing _z_0123456789 - -> Sing (Case_0123456789 (Apply (Apply (:$) _z_0123456789) (Apply (Apply (:$) y_0123456789) (Apply (Apply (:$) (Apply SuccSym0 _z_0123456789)) '[])))) + -> Sing (Case_0123456789 (Apply (Apply (:$) _z_0123456789) (Apply (Apply (:$) y_0123456789) (Apply (Apply (:$) (Apply SuccSym0 _z_0123456789)) '[]))) :: Nat) lambda _z_0123456789 y_0123456789 _z_0123456789 = y_0123456789 in lambda _s_z_0123456789 sY_0123456789 _s_z_0123456789 } :: - Sing (Case_0123456789 X_0123456789Sym0) + Sing (Case_0123456789 X_0123456789Sym0 :: Nat) sBlimy = case sX_0123456789 of { SCons _s_z_0123456789 @@ -603,10 +557,10 @@ Sing _z_0123456789 -> Sing _z_0123456789 -> Sing y_0123456789 - -> Sing (Case_0123456789 (Apply (Apply PairSym0 (Apply (Apply PairSym0 _z_0123456789) _z_0123456789)) y_0123456789)) + -> Sing (Case_0123456789 (Apply (Apply PairSym0 (Apply (Apply PairSym0 _z_0123456789) _z_0123456789)) y_0123456789) :: Bool) lambda _z_0123456789 _z_0123456789 y_0123456789 = y_0123456789 in lambda _s_z_0123456789 _s_z_0123456789 sY_0123456789 } :: - Sing (Case_0123456789 X_0123456789Sym0) + Sing (Case_0123456789 X_0123456789Sym0 :: Bool) sSz = case sX_0123456789 of { SPair sY_0123456789 _s_z_0123456789 diff --git a/tests/compile-and-dump/Singletons/PatternMatching.ghc80.template b/tests/compile-and-dump/Singletons/PatternMatching.ghc80.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/PatternMatching.ghc80.template @@ -0,0 +1,590 @@ +Singletons/PatternMatching.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| pr = Pair (Succ Zero) ([Zero]) + complex = Pair (Pair (Just Zero) Zero) False + tuple = (False, Just Zero, True) + aList = [Zero, Succ Zero, Succ (Succ Zero)] + + data Pair a b + = Pair a b + deriving (Show) |] + ======> + data Pair a b + = Pair a b + deriving (Show) + pr = Pair (Succ Zero) [Zero] + complex = Pair (Pair (Just Zero) Zero) False + tuple = (False, Just Zero, True) + aList = [Zero, Succ Zero, Succ (Succ Zero)] + type PairSym2 (t :: a0123456789) (t :: b0123456789) = Pair t t + instance SuppressUnusedWarnings PairSym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) PairSym1KindInference GHC.Tuple.()) + data PairSym1 (l :: a0123456789) + (l :: TyFun b0123456789 (Pair a0123456789 b0123456789)) + = forall arg. KindOf (Apply (PairSym1 l) arg) ~ KindOf (PairSym2 l arg) => + PairSym1KindInference + type instance Apply (PairSym1 l) l = PairSym2 l l + instance SuppressUnusedWarnings PairSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) PairSym0KindInference GHC.Tuple.()) + data PairSym0 (l :: TyFun a0123456789 (TyFun b0123456789 (Pair a0123456789 b0123456789) + -> GHC.Types.Type)) + = forall arg. KindOf (Apply PairSym0 arg) ~ KindOf (PairSym1 arg) => + PairSym0KindInference + type instance Apply PairSym0 l = PairSym1 l + type AListSym0 = AList + type TupleSym0 = Tuple + type ComplexSym0 = Complex + type PrSym0 = Pr + type family AList where + AList = Apply (Apply (:$) ZeroSym0) (Apply (Apply (:$) (Apply SuccSym0 ZeroSym0)) (Apply (Apply (:$) (Apply SuccSym0 (Apply SuccSym0 ZeroSym0))) '[])) + type family Tuple where + Tuple = Apply (Apply (Apply Tuple3Sym0 FalseSym0) (Apply JustSym0 ZeroSym0)) TrueSym0 + type family Complex where + Complex = Apply (Apply PairSym0 (Apply (Apply PairSym0 (Apply JustSym0 ZeroSym0)) ZeroSym0)) FalseSym0 + type family Pr where + Pr = Apply (Apply PairSym0 (Apply SuccSym0 ZeroSym0)) (Apply (Apply (:$) ZeroSym0) '[]) + sAList :: Sing AListSym0 + sTuple :: Sing TupleSym0 + sComplex :: Sing ComplexSym0 + sPr :: Sing PrSym0 + sAList + = applySing + (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SZero) + (applySing + (applySing + (singFun2 (Proxy :: Proxy (:$)) SCons) + (applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) SZero)) + (applySing + (applySing + (singFun2 (Proxy :: Proxy (:$)) SCons) + (applySing + (singFun1 (Proxy :: Proxy SuccSym0) SSucc) + (applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) SZero))) + SNil)) + sTuple + = applySing + (applySing + (applySing (singFun3 (Proxy :: Proxy Tuple3Sym0) STuple3) SFalse) + (applySing (singFun1 (Proxy :: Proxy JustSym0) SJust) SZero)) + STrue + sComplex + = applySing + (applySing + (singFun2 (Proxy :: Proxy PairSym0) SPair) + (applySing + (applySing + (singFun2 (Proxy :: Proxy PairSym0) SPair) + (applySing (singFun1 (Proxy :: Proxy JustSym0) SJust) SZero)) + SZero)) + SFalse + sPr + = applySing + (applySing + (singFun2 (Proxy :: Proxy PairSym0) SPair) + (applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) SZero)) + (applySing + (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SZero) SNil) + data instance Sing (z :: Pair a b) + = forall (n :: a) (n :: b). z ~ Pair n n => + SPair (Sing (n :: a)) (Sing (n :: b)) + type SPair = (Sing :: Pair a b -> GHC.Types.Type) + instance (SingKind (KProxy :: KProxy a), + SingKind (KProxy :: KProxy b)) => + SingKind (KProxy :: KProxy (Pair a b)) where + type DemoteRep (KProxy :: KProxy (Pair a b)) = Pair (DemoteRep (KProxy :: KProxy a)) (DemoteRep (KProxy :: KProxy b)) + fromSing (SPair b b) = Pair (fromSing b) (fromSing b) + toSing (Pair b b) + = case + GHC.Tuple.(,) + (toSing b :: SomeSing (KProxy :: KProxy a)) + (toSing b :: SomeSing (KProxy :: KProxy b)) + of { + GHC.Tuple.(,) (SomeSing c) (SomeSing c) -> SomeSing (SPair c c) } + instance (SingI n, SingI n) => SingI (Pair (n :: a) (n :: b)) where + sing = SPair sing sing +Singletons/PatternMatching.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| Pair sz lz = pr + Pair (Pair jz zz) fls = complex + (tf, tjz, tt) = tuple + [_, lsz, (Succ blimy)] = aList + lsz :: Nat + fls :: Bool + foo1 :: (a, b) -> a + foo1 (x, y) = (\ _ -> x) y + foo2 :: (# a, b #) -> a + foo2 t@(# x, y #) = case t of { (# a, b #) -> (\ _ -> a) b } + silly :: a -> () + silly x = case x of { _ -> () } |] + ======> + Pair sz lz = pr + Pair (Pair jz zz) fls = complex + (tf, tjz, tt) = tuple + [_, lsz, Succ blimy] = aList + lsz :: Nat + fls :: Bool + foo1 :: forall a b. (a, b) -> a + foo1 (x, y) = (\ _ -> x) y + foo2 :: forall a b. (# a, b #) -> a + foo2 t@(# x, y #) = case t of { (# a, b #) -> (\ _ -> a) b } + silly :: forall a. a -> () + silly x = case x of { _ -> GHC.Tuple.() } + type family Case_0123456789 x t where + Case_0123456789 x _z_0123456789 = Tuple0Sym0 + type Let0123456789TSym2 t t = Let0123456789T t t + instance SuppressUnusedWarnings Let0123456789TSym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Let0123456789TSym1KindInference GHC.Tuple.()) + data Let0123456789TSym1 l l + = forall arg. KindOf (Apply (Let0123456789TSym1 l) arg) ~ KindOf (Let0123456789TSym2 l arg) => + Let0123456789TSym1KindInference + type instance Apply (Let0123456789TSym1 l) l = Let0123456789TSym2 l l + instance SuppressUnusedWarnings Let0123456789TSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Let0123456789TSym0KindInference GHC.Tuple.()) + data Let0123456789TSym0 l + = forall arg. KindOf (Apply Let0123456789TSym0 arg) ~ KindOf (Let0123456789TSym1 arg) => + Let0123456789TSym0KindInference + type instance Apply Let0123456789TSym0 l = Let0123456789TSym1 l + type family Let0123456789T x y where + Let0123456789T x y = Apply (Apply Tuple2Sym0 x) y + type family Case_0123456789 x y a b arg_0123456789 t where + Case_0123456789 x y a b arg_0123456789 _z_0123456789 = a + type family Lambda_0123456789 x y a b t where + Lambda_0123456789 x y a b arg_0123456789 = Case_0123456789 x y a b arg_0123456789 arg_0123456789 + type Lambda_0123456789Sym5 t t t t t = Lambda_0123456789 t t t t t + instance SuppressUnusedWarnings Lambda_0123456789Sym4 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym4KindInference GHC.Tuple.()) + data Lambda_0123456789Sym4 l l l l l + = forall arg. KindOf (Apply (Lambda_0123456789Sym4 l l l l) arg) ~ KindOf (Lambda_0123456789Sym5 l l l l arg) => + Lambda_0123456789Sym4KindInference + type instance Apply (Lambda_0123456789Sym4 l l l l) l = Lambda_0123456789Sym5 l l l l l + instance SuppressUnusedWarnings Lambda_0123456789Sym3 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym3KindInference GHC.Tuple.()) + data Lambda_0123456789Sym3 l l l l + = forall arg. KindOf (Apply (Lambda_0123456789Sym3 l l l) arg) ~ KindOf (Lambda_0123456789Sym4 l l l arg) => + Lambda_0123456789Sym3KindInference + type instance Apply (Lambda_0123456789Sym3 l l l) l = Lambda_0123456789Sym4 l l l l + instance SuppressUnusedWarnings Lambda_0123456789Sym2 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym2KindInference GHC.Tuple.()) + data Lambda_0123456789Sym2 l l l + = forall arg. KindOf (Apply (Lambda_0123456789Sym2 l l) arg) ~ KindOf (Lambda_0123456789Sym3 l l arg) => + Lambda_0123456789Sym2KindInference + type instance Apply (Lambda_0123456789Sym2 l l) l = Lambda_0123456789Sym3 l l l + instance SuppressUnusedWarnings Lambda_0123456789Sym1 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym1KindInference GHC.Tuple.()) + data Lambda_0123456789Sym1 l l + = forall arg. KindOf (Apply (Lambda_0123456789Sym1 l) arg) ~ KindOf (Lambda_0123456789Sym2 l arg) => + Lambda_0123456789Sym1KindInference + type instance Apply (Lambda_0123456789Sym1 l) l = Lambda_0123456789Sym2 l l + instance SuppressUnusedWarnings Lambda_0123456789Sym0 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym0KindInference GHC.Tuple.()) + data Lambda_0123456789Sym0 l + = forall arg. KindOf (Apply Lambda_0123456789Sym0 arg) ~ KindOf (Lambda_0123456789Sym1 arg) => + Lambda_0123456789Sym0KindInference + type instance Apply Lambda_0123456789Sym0 l = Lambda_0123456789Sym1 l + type family Case_0123456789 x y t where + Case_0123456789 x y '(a, + b) = Apply (Apply (Apply (Apply (Apply Lambda_0123456789Sym0 x) y) a) b) b + type family Case_0123456789 x y arg_0123456789 t where + Case_0123456789 x y arg_0123456789 _z_0123456789 = x + type family Lambda_0123456789 x y t where + Lambda_0123456789 x y arg_0123456789 = Case_0123456789 x y arg_0123456789 arg_0123456789 + type Lambda_0123456789Sym3 t t t = Lambda_0123456789 t t t + instance SuppressUnusedWarnings Lambda_0123456789Sym2 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym2KindInference GHC.Tuple.()) + data Lambda_0123456789Sym2 l l l + = forall arg. KindOf (Apply (Lambda_0123456789Sym2 l l) arg) ~ KindOf (Lambda_0123456789Sym3 l l arg) => + Lambda_0123456789Sym2KindInference + type instance Apply (Lambda_0123456789Sym2 l l) l = Lambda_0123456789Sym3 l l l + instance SuppressUnusedWarnings Lambda_0123456789Sym1 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym1KindInference GHC.Tuple.()) + data Lambda_0123456789Sym1 l l + = forall arg. KindOf (Apply (Lambda_0123456789Sym1 l) arg) ~ KindOf (Lambda_0123456789Sym2 l arg) => + Lambda_0123456789Sym1KindInference + type instance Apply (Lambda_0123456789Sym1 l) l = Lambda_0123456789Sym2 l l + instance SuppressUnusedWarnings Lambda_0123456789Sym0 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym0KindInference GHC.Tuple.()) + data Lambda_0123456789Sym0 l + = forall arg. KindOf (Apply Lambda_0123456789Sym0 arg) ~ KindOf (Lambda_0123456789Sym1 arg) => + Lambda_0123456789Sym0KindInference + type instance Apply Lambda_0123456789Sym0 l = Lambda_0123456789Sym1 l + type family Case_0123456789 t where + Case_0123456789 '[_z_0123456789, + y_0123456789, + Succ _z_0123456789] = y_0123456789 + type family Case_0123456789 t where + Case_0123456789 '[_z_0123456789, + _z_0123456789, + Succ y_0123456789] = y_0123456789 + type family Case_0123456789 t where + Case_0123456789 '(y_0123456789, + _z_0123456789, + _z_0123456789) = y_0123456789 + type family Case_0123456789 t where + Case_0123456789 '(_z_0123456789, + y_0123456789, + _z_0123456789) = y_0123456789 + type family Case_0123456789 t where + Case_0123456789 '(_z_0123456789, + _z_0123456789, + y_0123456789) = y_0123456789 + type family Case_0123456789 t where + Case_0123456789 (Pair (Pair y_0123456789 _z_0123456789) _z_0123456789) = y_0123456789 + type family Case_0123456789 t where + Case_0123456789 (Pair (Pair _z_0123456789 y_0123456789) _z_0123456789) = y_0123456789 + type family Case_0123456789 t where + Case_0123456789 (Pair (Pair _z_0123456789 _z_0123456789) y_0123456789) = y_0123456789 + type family Case_0123456789 t where + Case_0123456789 (Pair y_0123456789 _z_0123456789) = y_0123456789 + type family Case_0123456789 t where + Case_0123456789 (Pair _z_0123456789 y_0123456789) = y_0123456789 + type SillySym1 (t :: a0123456789) = Silly t + instance SuppressUnusedWarnings SillySym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) SillySym0KindInference GHC.Tuple.()) + data SillySym0 (l :: TyFun a0123456789 ()) + = forall arg. KindOf (Apply SillySym0 arg) ~ KindOf (SillySym1 arg) => + SillySym0KindInference + type instance Apply SillySym0 l = SillySym1 l + type Foo2Sym1 (t :: (a0123456789, b0123456789)) = Foo2 t + instance SuppressUnusedWarnings Foo2Sym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Foo2Sym0KindInference GHC.Tuple.()) + data Foo2Sym0 (l :: TyFun (a0123456789, b0123456789) a0123456789) + = forall arg. KindOf (Apply Foo2Sym0 arg) ~ KindOf (Foo2Sym1 arg) => + Foo2Sym0KindInference + type instance Apply Foo2Sym0 l = Foo2Sym1 l + type Foo1Sym1 (t :: (a0123456789, b0123456789)) = Foo1 t + instance SuppressUnusedWarnings Foo1Sym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Foo1Sym0KindInference GHC.Tuple.()) + data Foo1Sym0 (l :: TyFun (a0123456789, b0123456789) a0123456789) + = forall arg. KindOf (Apply Foo1Sym0 arg) ~ KindOf (Foo1Sym1 arg) => + Foo1Sym0KindInference + type instance Apply Foo1Sym0 l = Foo1Sym1 l + 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 X_0123456789Sym0 = X_0123456789 + type X_0123456789Sym0 = X_0123456789 + type X_0123456789Sym0 = X_0123456789 + type X_0123456789Sym0 = X_0123456789 + type family Silly (a :: a) :: () where + Silly x = Case_0123456789 x x + type family Foo2 (a :: (a, b)) :: a where + Foo2 '(x, y) = Case_0123456789 x y (Let0123456789TSym2 x y) + type family Foo1 (a :: (a, b)) :: a where + Foo1 '(x, y) = Apply (Apply (Apply Lambda_0123456789Sym0 x) y) y + type family Lsz :: Nat where + Lsz = Case_0123456789 X_0123456789Sym0 + type family Blimy where + Blimy = Case_0123456789 X_0123456789Sym0 + type family Tf where + Tf = Case_0123456789 X_0123456789Sym0 + type family Tjz where + Tjz = Case_0123456789 X_0123456789Sym0 + type family Tt where + Tt = Case_0123456789 X_0123456789Sym0 + type family Jz where + Jz = Case_0123456789 X_0123456789Sym0 + type family Zz where + Zz = Case_0123456789 X_0123456789Sym0 + type family Fls :: Bool where + Fls = Case_0123456789 X_0123456789Sym0 + type family Sz where + Sz = Case_0123456789 X_0123456789Sym0 + type family Lz where + Lz = Case_0123456789 X_0123456789Sym0 + type family X_0123456789 where + X_0123456789 = PrSym0 + type family X_0123456789 where + X_0123456789 = ComplexSym0 + type family X_0123456789 where + X_0123456789 = TupleSym0 + type family X_0123456789 where + X_0123456789 = AListSym0 + sSilly :: forall (t :: a). Sing t -> Sing (Apply SillySym0 t :: ()) + sFoo2 :: + forall (t :: (a, b)). Sing t -> Sing (Apply Foo2Sym0 t :: a) + sFoo1 :: + forall (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 + sX_0123456789 :: Sing X_0123456789Sym0 + sX_0123456789 :: Sing X_0123456789Sym0 + sX_0123456789 :: Sing X_0123456789Sym0 + sX_0123456789 :: Sing X_0123456789Sym0 + sSilly sX + = let + lambda :: + forall x. t ~ x => Sing x -> Sing (Apply SillySym0 t :: ()) + lambda x + = case x of { + _s_z_0123456789 + -> let + lambda :: + forall _z_0123456789. + _z_0123456789 ~ x => + Sing _z_0123456789 -> Sing (Case_0123456789 x _z_0123456789 :: ()) + lambda _z_0123456789 = STuple0 + in lambda _s_z_0123456789 } :: + Sing (Case_0123456789 x x :: ()) + in lambda sX + sFoo2 (STuple2 sX sY) + = let + lambda :: + forall x y. + t ~ Apply (Apply Tuple2Sym0 x) y => + Sing x -> Sing y -> Sing (Apply Foo2Sym0 t :: a) + lambda x y + = let + sT :: Sing (Let0123456789TSym2 x y) + sT + = applySing + (applySing (singFun2 (Proxy :: Proxy Tuple2Sym0) STuple2) x) y + in case sT of { + STuple2 sA sB + -> let + lambda :: + forall a b. + Apply (Apply Tuple2Sym0 a) b ~ Let0123456789TSym2 x y => + Sing a + -> Sing b + -> Sing (Case_0123456789 x y (Apply (Apply Tuple2Sym0 a) b) :: a) + lambda a b + = applySing + (singFun1 + (Proxy :: + Proxy (Apply (Apply (Apply (Apply Lambda_0123456789Sym0 x) y) a) b)) + (\ sArg_0123456789 + -> let + lambda :: + forall arg_0123456789. + Sing arg_0123456789 + -> Sing (Apply (Apply (Apply (Apply (Apply Lambda_0123456789Sym0 x) y) a) b) arg_0123456789) + lambda arg_0123456789 + = case arg_0123456789 of { + _s_z_0123456789 + -> let + lambda :: + forall _z_0123456789. + _z_0123456789 ~ arg_0123456789 => + Sing _z_0123456789 + -> Sing (Case_0123456789 x y a b arg_0123456789 _z_0123456789) + lambda _z_0123456789 = a + in lambda _s_z_0123456789 } :: + Sing (Case_0123456789 x y a b arg_0123456789 arg_0123456789) + in lambda sArg_0123456789)) + b + in lambda sA sB } :: + Sing (Case_0123456789 x y (Let0123456789TSym2 x y) :: a) + in lambda sX sY + sFoo1 (STuple2 sX sY) + = let + lambda :: + forall x y. + t ~ Apply (Apply Tuple2Sym0 x) y => + Sing x -> Sing y -> Sing (Apply Foo1Sym0 t :: a) + lambda x y + = applySing + (singFun1 + (Proxy :: Proxy (Apply (Apply Lambda_0123456789Sym0 x) y)) + (\ sArg_0123456789 + -> let + lambda :: + forall arg_0123456789. + Sing arg_0123456789 + -> Sing (Apply (Apply (Apply Lambda_0123456789Sym0 x) y) arg_0123456789) + lambda arg_0123456789 + = case arg_0123456789 of { + _s_z_0123456789 + -> let + lambda :: + forall _z_0123456789. + _z_0123456789 ~ arg_0123456789 => + Sing _z_0123456789 + -> Sing (Case_0123456789 x y arg_0123456789 _z_0123456789) + lambda _z_0123456789 = x + in lambda _s_z_0123456789 } :: + Sing (Case_0123456789 x y arg_0123456789 arg_0123456789) + in lambda sArg_0123456789)) + y + in lambda sX sY + sLsz + = case sX_0123456789 of { + SCons _s_z_0123456789 + (SCons sY_0123456789 (SCons (SSucc _s_z_0123456789) SNil)) + -> let + lambda :: + forall _z_0123456789 y_0123456789 _z_0123456789. + Apply (Apply (:$) _z_0123456789) (Apply (Apply (:$) y_0123456789) (Apply (Apply (:$) (Apply SuccSym0 _z_0123456789)) '[])) ~ X_0123456789Sym0 => + Sing _z_0123456789 + -> Sing y_0123456789 + -> Sing _z_0123456789 + -> Sing (Case_0123456789 (Apply (Apply (:$) _z_0123456789) (Apply (Apply (:$) y_0123456789) (Apply (Apply (:$) (Apply SuccSym0 _z_0123456789)) '[]))) :: Nat) + lambda _z_0123456789 y_0123456789 _z_0123456789 = y_0123456789 + in lambda _s_z_0123456789 sY_0123456789 _s_z_0123456789 } :: + Sing (Case_0123456789 X_0123456789Sym0 :: Nat) + sBlimy + = case sX_0123456789 of { + SCons _s_z_0123456789 + (SCons _s_z_0123456789 (SCons (SSucc sY_0123456789) SNil)) + -> let + lambda :: + forall _z_0123456789 _z_0123456789 y_0123456789. + Apply (Apply (:$) _z_0123456789) (Apply (Apply (:$) _z_0123456789) (Apply (Apply (:$) (Apply SuccSym0 y_0123456789)) '[])) ~ X_0123456789Sym0 => + Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing y_0123456789 + -> Sing (Case_0123456789 (Apply (Apply (:$) _z_0123456789) (Apply (Apply (:$) _z_0123456789) (Apply (Apply (:$) (Apply SuccSym0 y_0123456789)) '[])))) + lambda _z_0123456789 _z_0123456789 y_0123456789 = y_0123456789 + in lambda _s_z_0123456789 _s_z_0123456789 sY_0123456789 } :: + Sing (Case_0123456789 X_0123456789Sym0) + sTf + = case sX_0123456789 of { + STuple3 sY_0123456789 _s_z_0123456789 _s_z_0123456789 + -> let + lambda :: + forall y_0123456789 _z_0123456789 _z_0123456789. + Apply (Apply (Apply Tuple3Sym0 y_0123456789) _z_0123456789) _z_0123456789 ~ X_0123456789Sym0 => + Sing y_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing (Case_0123456789 (Apply (Apply (Apply Tuple3Sym0 y_0123456789) _z_0123456789) _z_0123456789)) + lambda y_0123456789 _z_0123456789 _z_0123456789 = y_0123456789 + in lambda sY_0123456789 _s_z_0123456789 _s_z_0123456789 } :: + Sing (Case_0123456789 X_0123456789Sym0) + sTjz + = case sX_0123456789 of { + STuple3 _s_z_0123456789 sY_0123456789 _s_z_0123456789 + -> let + lambda :: + forall _z_0123456789 y_0123456789 _z_0123456789. + Apply (Apply (Apply Tuple3Sym0 _z_0123456789) y_0123456789) _z_0123456789 ~ X_0123456789Sym0 => + Sing _z_0123456789 + -> Sing y_0123456789 + -> Sing _z_0123456789 + -> Sing (Case_0123456789 (Apply (Apply (Apply Tuple3Sym0 _z_0123456789) y_0123456789) _z_0123456789)) + lambda _z_0123456789 y_0123456789 _z_0123456789 = y_0123456789 + in lambda _s_z_0123456789 sY_0123456789 _s_z_0123456789 } :: + Sing (Case_0123456789 X_0123456789Sym0) + sTt + = case sX_0123456789 of { + STuple3 _s_z_0123456789 _s_z_0123456789 sY_0123456789 + -> let + lambda :: + forall _z_0123456789 _z_0123456789 y_0123456789. + Apply (Apply (Apply Tuple3Sym0 _z_0123456789) _z_0123456789) y_0123456789 ~ X_0123456789Sym0 => + Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing y_0123456789 + -> Sing (Case_0123456789 (Apply (Apply (Apply Tuple3Sym0 _z_0123456789) _z_0123456789) y_0123456789)) + lambda _z_0123456789 _z_0123456789 y_0123456789 = y_0123456789 + in lambda _s_z_0123456789 _s_z_0123456789 sY_0123456789 } :: + Sing (Case_0123456789 X_0123456789Sym0) + sJz + = case sX_0123456789 of { + SPair (SPair sY_0123456789 _s_z_0123456789) _s_z_0123456789 + -> let + lambda :: + forall y_0123456789 _z_0123456789 _z_0123456789. + Apply (Apply PairSym0 (Apply (Apply PairSym0 y_0123456789) _z_0123456789)) _z_0123456789 ~ X_0123456789Sym0 => + Sing y_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing (Case_0123456789 (Apply (Apply PairSym0 (Apply (Apply PairSym0 y_0123456789) _z_0123456789)) _z_0123456789)) + lambda y_0123456789 _z_0123456789 _z_0123456789 = y_0123456789 + in lambda sY_0123456789 _s_z_0123456789 _s_z_0123456789 } :: + Sing (Case_0123456789 X_0123456789Sym0) + sZz + = case sX_0123456789 of { + SPair (SPair _s_z_0123456789 sY_0123456789) _s_z_0123456789 + -> let + lambda :: + forall _z_0123456789 y_0123456789 _z_0123456789. + Apply (Apply PairSym0 (Apply (Apply PairSym0 _z_0123456789) y_0123456789)) _z_0123456789 ~ X_0123456789Sym0 => + Sing _z_0123456789 + -> Sing y_0123456789 + -> Sing _z_0123456789 + -> Sing (Case_0123456789 (Apply (Apply PairSym0 (Apply (Apply PairSym0 _z_0123456789) y_0123456789)) _z_0123456789)) + lambda _z_0123456789 y_0123456789 _z_0123456789 = y_0123456789 + in lambda _s_z_0123456789 sY_0123456789 _s_z_0123456789 } :: + Sing (Case_0123456789 X_0123456789Sym0) + sFls + = case sX_0123456789 of { + SPair (SPair _s_z_0123456789 _s_z_0123456789) sY_0123456789 + -> let + lambda :: + forall _z_0123456789 _z_0123456789 y_0123456789. + Apply (Apply PairSym0 (Apply (Apply PairSym0 _z_0123456789) _z_0123456789)) y_0123456789 ~ X_0123456789Sym0 => + Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing y_0123456789 + -> Sing (Case_0123456789 (Apply (Apply PairSym0 (Apply (Apply PairSym0 _z_0123456789) _z_0123456789)) y_0123456789) :: Bool) + lambda _z_0123456789 _z_0123456789 y_0123456789 = y_0123456789 + in lambda _s_z_0123456789 _s_z_0123456789 sY_0123456789 } :: + Sing (Case_0123456789 X_0123456789Sym0 :: Bool) + sSz + = case sX_0123456789 of { + SPair sY_0123456789 _s_z_0123456789 + -> let + lambda :: + forall y_0123456789 _z_0123456789. + Apply (Apply PairSym0 y_0123456789) _z_0123456789 ~ X_0123456789Sym0 => + Sing y_0123456789 + -> Sing _z_0123456789 + -> Sing (Case_0123456789 (Apply (Apply PairSym0 y_0123456789) _z_0123456789)) + lambda y_0123456789 _z_0123456789 = y_0123456789 + in lambda sY_0123456789 _s_z_0123456789 } :: + Sing (Case_0123456789 X_0123456789Sym0) + sLz + = case sX_0123456789 of { + SPair _s_z_0123456789 sY_0123456789 + -> let + lambda :: + forall _z_0123456789 y_0123456789. + Apply (Apply PairSym0 _z_0123456789) y_0123456789 ~ X_0123456789Sym0 => + Sing _z_0123456789 + -> Sing y_0123456789 + -> Sing (Case_0123456789 (Apply (Apply PairSym0 _z_0123456789) y_0123456789)) + lambda _z_0123456789 y_0123456789 = y_0123456789 + in lambda _s_z_0123456789 sY_0123456789 } :: + Sing (Case_0123456789 X_0123456789Sym0) + sX_0123456789 = sPr + sX_0123456789 = sComplex + sX_0123456789 = sTuple + sX_0123456789 = sAList diff --git a/tests/compile-and-dump/Singletons/Records.ghc710.template b/tests/compile-and-dump/Singletons/Records.ghc710.template --- a/tests/compile-and-dump/Singletons/Records.ghc710.template +++ b/tests/compile-and-dump/Singletons/Records.ghc710.template @@ -3,19 +3,19 @@ [d| data Record a = MkRecord {field1 :: a, field2 :: Bool} |] ======> data Record a = MkRecord {field1 :: a, field2 :: Bool} - type Field1Sym1 (t :: Record a) = Field1 t + type Field1Sym1 (t :: Record a0123456789) = Field1 t instance SuppressUnusedWarnings Field1Sym0 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) Field1Sym0KindInference GHC.Tuple.()) - data Field1Sym0 (l :: TyFun (Record a) a) + data Field1Sym0 (l :: TyFun (Record a0123456789) a0123456789) = forall arg. KindOf (Apply Field1Sym0 arg) ~ KindOf (Field1Sym1 arg) => Field1Sym0KindInference type instance Apply Field1Sym0 l = Field1Sym1 l - type Field2Sym1 (t :: Record a) = Field2 t + type Field2Sym1 (t :: Record a0123456789) = Field2 t instance SuppressUnusedWarnings Field2Sym0 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) Field2Sym0KindInference GHC.Tuple.()) - data Field2Sym0 (l :: TyFun (Record a) Bool) + data Field2Sym0 (l :: TyFun (Record a0123456789) Bool) = forall arg. KindOf (Apply Field2Sym0 arg) ~ KindOf (Field2Sym1 arg) => Field2Sym0KindInference type instance Apply Field2Sym0 l = Field2Sym1 l @@ -23,18 +23,20 @@ Field1 (MkRecord field _z_0123456789) = field type family Field2 (a :: Record a) :: Bool where Field2 (MkRecord _z_0123456789 field) = field - type MkRecordSym2 (t :: a) (t :: Bool) = MkRecord t t + type MkRecordSym2 (t :: a0123456789) (t :: Bool) = MkRecord t t instance SuppressUnusedWarnings MkRecordSym1 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) MkRecordSym1KindInference GHC.Tuple.()) - data MkRecordSym1 (l :: a) (l :: TyFun Bool (Record a)) + data MkRecordSym1 (l :: a0123456789) + (l :: TyFun Bool (Record a0123456789)) = forall arg. KindOf (Apply (MkRecordSym1 l) arg) ~ KindOf (MkRecordSym2 l arg) => MkRecordSym1KindInference type instance Apply (MkRecordSym1 l) l = MkRecordSym2 l l instance SuppressUnusedWarnings MkRecordSym0 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) MkRecordSym0KindInference GHC.Tuple.()) - data MkRecordSym0 (l :: TyFun a (TyFun Bool (Record a) -> *)) + data MkRecordSym0 (l :: TyFun a0123456789 (TyFun Bool (Record a0123456789) + -> *)) = forall arg. KindOf (Apply MkRecordSym0 arg) ~ KindOf (MkRecordSym1 arg) => MkRecordSym0KindInference type instance Apply MkRecordSym0 l = MkRecordSym1 l diff --git a/tests/compile-and-dump/Singletons/Records.ghc80.template b/tests/compile-and-dump/Singletons/Records.ghc80.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/Records.ghc80.template @@ -0,0 +1,62 @@ +Singletons/Records.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| data Record a = MkRecord {field1 :: a, field2 :: Bool} |] + ======> + data Record a = MkRecord {field1 :: a, field2 :: Bool} + type Field1Sym1 (t :: Record a0123456789) = Field1 t + instance SuppressUnusedWarnings Field1Sym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Field1Sym0KindInference GHC.Tuple.()) + data Field1Sym0 (l :: TyFun (Record a0123456789) a0123456789) + = forall arg. KindOf (Apply Field1Sym0 arg) ~ KindOf (Field1Sym1 arg) => + Field1Sym0KindInference + type instance Apply Field1Sym0 l = Field1Sym1 l + type Field2Sym1 (t :: Record a0123456789) = Field2 t + instance SuppressUnusedWarnings Field2Sym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Field2Sym0KindInference GHC.Tuple.()) + data Field2Sym0 (l :: TyFun (Record a0123456789) Bool) + = forall arg. KindOf (Apply Field2Sym0 arg) ~ KindOf (Field2Sym1 arg) => + Field2Sym0KindInference + type instance Apply Field2Sym0 l = Field2Sym1 l + type family Field1 (a :: Record a) :: a where + Field1 (MkRecord field _z_0123456789) = field + type family Field2 (a :: Record a) :: Bool where + Field2 (MkRecord _z_0123456789 field) = field + type MkRecordSym2 (t :: a0123456789) (t :: Bool) = MkRecord t t + instance SuppressUnusedWarnings MkRecordSym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) MkRecordSym1KindInference GHC.Tuple.()) + data MkRecordSym1 (l :: a0123456789) + (l :: TyFun Bool (Record a0123456789)) + = forall arg. KindOf (Apply (MkRecordSym1 l) arg) ~ KindOf (MkRecordSym2 l arg) => + MkRecordSym1KindInference + type instance Apply (MkRecordSym1 l) l = MkRecordSym2 l l + instance SuppressUnusedWarnings MkRecordSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) MkRecordSym0KindInference GHC.Tuple.()) + data MkRecordSym0 (l :: TyFun a0123456789 (TyFun Bool (Record a0123456789) + -> GHC.Types.Type)) + = forall arg. KindOf (Apply MkRecordSym0 arg) ~ KindOf (MkRecordSym1 arg) => + MkRecordSym0KindInference + type instance Apply MkRecordSym0 l = MkRecordSym1 l + data instance Sing (z :: Record a) + = forall (n :: a) (n :: Bool). z ~ MkRecord n n => + SMkRecord {sField1 :: (Sing (n :: a)), + sField2 :: (Sing (n :: Bool))} + type SRecord = (Sing :: Record a -> GHC.Types.Type) + instance SingKind (KProxy :: KProxy a) => + SingKind (KProxy :: KProxy (Record a)) where + type DemoteRep (KProxy :: KProxy (Record a)) = Record (DemoteRep (KProxy :: KProxy a)) + fromSing (SMkRecord b b) = MkRecord (fromSing b) (fromSing b) + toSing (MkRecord b b) + = case + GHC.Tuple.(,) + (toSing b :: SomeSing (KProxy :: KProxy a)) + (toSing b :: SomeSing (KProxy :: KProxy Bool)) + of { + GHC.Tuple.(,) (SomeSing c) (SomeSing c) + -> SomeSing (SMkRecord c c) } + instance (SingI n, SingI n) => + SingI (MkRecord (n :: a) (n :: Bool)) where + sing = SMkRecord sing sing diff --git a/tests/compile-and-dump/Singletons/ReturnFunc.ghc710.template b/tests/compile-and-dump/Singletons/ReturnFunc.ghc710.template --- a/tests/compile-and-dump/Singletons/ReturnFunc.ghc710.template +++ b/tests/compile-and-dump/Singletons/ReturnFunc.ghc710.template @@ -13,26 +13,28 @@ id x = x idFoo :: forall c a. c -> a -> a idFoo _ = id - type IdSym1 (t :: a) = Id t + type IdSym1 (t :: a0123456789) = Id t instance SuppressUnusedWarnings IdSym0 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) IdSym0KindInference GHC.Tuple.()) - data IdSym0 (l :: TyFun a a) + data IdSym0 (l :: TyFun a0123456789 a0123456789) = forall arg. KindOf (Apply IdSym0 arg) ~ KindOf (IdSym1 arg) => IdSym0KindInference type instance Apply IdSym0 l = IdSym1 l - type IdFooSym2 (t :: c) (t :: a) = IdFoo t t + type IdFooSym2 (t :: c0123456789) (t :: a0123456789) = IdFoo t t instance SuppressUnusedWarnings IdFooSym1 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) IdFooSym1KindInference GHC.Tuple.()) - data IdFooSym1 (l :: c) (l :: TyFun a a) + data IdFooSym1 (l :: c0123456789) + (l :: TyFun a0123456789 a0123456789) = forall arg. KindOf (Apply (IdFooSym1 l) arg) ~ KindOf (IdFooSym2 l arg) => IdFooSym1KindInference type instance Apply (IdFooSym1 l) l = IdFooSym2 l l instance SuppressUnusedWarnings IdFooSym0 where suppressUnusedWarnings _ = snd (GHC.Tuple.(,) IdFooSym0KindInference GHC.Tuple.()) - data IdFooSym0 (l :: TyFun c (TyFun a a -> *)) + data IdFooSym0 (l :: TyFun c0123456789 (TyFun a0123456789 a0123456789 + -> *)) = forall arg. KindOf (Apply IdFooSym0 arg) ~ KindOf (IdFooSym1 arg) => IdFooSym0KindInference type instance Apply IdFooSym0 l = IdFooSym1 l @@ -66,7 +68,7 @@ Sing t -> Sing t -> Sing (Apply (Apply ReturnFuncSym0 t) t :: Nat) sId sX = let - lambda :: forall x. t ~ x => Sing x -> Sing (Apply IdSym0 x :: a) + lambda :: forall x. t ~ x => Sing x -> Sing (Apply IdSym0 t :: a) lambda x = x in lambda sX sIdFoo _s_z_0123456789 sA_0123456789 @@ -75,8 +77,7 @@ forall _z_0123456789 a_0123456789. (t ~ _z_0123456789, t ~ a_0123456789) => Sing _z_0123456789 - -> Sing a_0123456789 - -> Sing (Apply (Apply IdFooSym0 _z_0123456789) a_0123456789 :: a) + -> Sing a_0123456789 -> Sing (Apply (Apply IdFooSym0 t) t :: a) lambda _z_0123456789 a_0123456789 = applySing (singFun1 (Proxy :: Proxy IdSym0) sId) a_0123456789 in lambda _s_z_0123456789 sA_0123456789 @@ -87,7 +88,7 @@ t ~ a_0123456789) => Sing _z_0123456789 -> Sing a_0123456789 - -> Sing (Apply (Apply ReturnFuncSym0 _z_0123456789) a_0123456789 :: Nat) + -> Sing (Apply (Apply ReturnFuncSym0 t) t :: Nat) lambda _z_0123456789 a_0123456789 = applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) a_0123456789 in lambda _s_z_0123456789 sA_0123456789 diff --git a/tests/compile-and-dump/Singletons/ReturnFunc.ghc80.template b/tests/compile-and-dump/Singletons/ReturnFunc.ghc80.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/ReturnFunc.ghc80.template @@ -0,0 +1,95 @@ +Singletons/ReturnFunc.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| returnFunc :: Nat -> Nat -> Nat + returnFunc _ = Succ + id :: a -> a + id x = x + idFoo :: c -> a -> a + idFoo _ = id |] + ======> + returnFunc :: Nat -> Nat -> Nat + returnFunc _ = Succ + id :: forall a. a -> a + id x = x + idFoo :: forall c a. c -> a -> a + idFoo _ = id + type IdSym1 (t :: a0123456789) = Id t + instance SuppressUnusedWarnings IdSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) IdSym0KindInference GHC.Tuple.()) + data IdSym0 (l :: TyFun a0123456789 a0123456789) + = forall arg. KindOf (Apply IdSym0 arg) ~ KindOf (IdSym1 arg) => + IdSym0KindInference + type instance Apply IdSym0 l = IdSym1 l + type IdFooSym2 (t :: c0123456789) (t :: a0123456789) = IdFoo t t + instance SuppressUnusedWarnings IdFooSym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) IdFooSym1KindInference GHC.Tuple.()) + data IdFooSym1 (l :: c0123456789) + (l :: TyFun a0123456789 a0123456789) + = forall arg. KindOf (Apply (IdFooSym1 l) arg) ~ KindOf (IdFooSym2 l arg) => + IdFooSym1KindInference + type instance Apply (IdFooSym1 l) l = IdFooSym2 l l + instance SuppressUnusedWarnings IdFooSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) IdFooSym0KindInference GHC.Tuple.()) + data IdFooSym0 (l :: TyFun c0123456789 (TyFun a0123456789 a0123456789 + -> GHC.Types.Type)) + = forall arg. KindOf (Apply IdFooSym0 arg) ~ KindOf (IdFooSym1 arg) => + IdFooSym0KindInference + type instance Apply IdFooSym0 l = IdFooSym1 l + type ReturnFuncSym2 (t :: Nat) (t :: Nat) = ReturnFunc t t + instance SuppressUnusedWarnings ReturnFuncSym1 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) ReturnFuncSym1KindInference GHC.Tuple.()) + data ReturnFuncSym1 (l :: Nat) (l :: TyFun Nat Nat) + = forall arg. KindOf (Apply (ReturnFuncSym1 l) arg) ~ KindOf (ReturnFuncSym2 l arg) => + ReturnFuncSym1KindInference + type instance Apply (ReturnFuncSym1 l) l = ReturnFuncSym2 l l + instance SuppressUnusedWarnings ReturnFuncSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) ReturnFuncSym0KindInference GHC.Tuple.()) + data ReturnFuncSym0 (l :: TyFun Nat (TyFun Nat Nat + -> GHC.Types.Type)) + = forall arg. KindOf (Apply ReturnFuncSym0 arg) ~ KindOf (ReturnFuncSym1 arg) => + ReturnFuncSym0KindInference + type instance Apply ReturnFuncSym0 l = ReturnFuncSym1 l + type family Id (a :: a) :: a where + Id x = x + type family IdFoo (a :: c) (a :: a) :: a where + IdFoo _z_0123456789 a_0123456789 = Apply IdSym0 a_0123456789 + type family ReturnFunc (a :: Nat) (a :: Nat) :: Nat where + ReturnFunc _z_0123456789 a_0123456789 = Apply SuccSym0 a_0123456789 + sId :: forall (t :: a). Sing t -> Sing (Apply IdSym0 t :: a) + sIdFoo :: + forall (t :: c) (t :: a). + Sing t -> Sing t -> Sing (Apply (Apply IdFooSym0 t) t :: a) + sReturnFunc :: + forall (t :: Nat) (t :: Nat). + Sing t -> Sing t -> Sing (Apply (Apply ReturnFuncSym0 t) t :: Nat) + sId sX + = let + lambda :: forall x. t ~ x => Sing x -> Sing (Apply IdSym0 t :: a) + lambda x = x + in lambda sX + sIdFoo _s_z_0123456789 sA_0123456789 + = let + lambda :: + forall _z_0123456789 a_0123456789. + (t ~ _z_0123456789, t ~ a_0123456789) => + Sing _z_0123456789 + -> Sing a_0123456789 -> Sing (Apply (Apply IdFooSym0 t) t :: a) + lambda _z_0123456789 a_0123456789 + = applySing (singFun1 (Proxy :: Proxy IdSym0) sId) a_0123456789 + in lambda _s_z_0123456789 sA_0123456789 + sReturnFunc _s_z_0123456789 sA_0123456789 + = let + lambda :: + forall _z_0123456789 a_0123456789. + (t ~ _z_0123456789, t ~ a_0123456789) => + Sing _z_0123456789 + -> Sing a_0123456789 + -> Sing (Apply (Apply ReturnFuncSym0 t) t :: Nat) + lambda _z_0123456789 a_0123456789 + = applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) a_0123456789 + in lambda _s_z_0123456789 sA_0123456789 diff --git a/tests/compile-and-dump/Singletons/Sections.ghc710.template b/tests/compile-and-dump/Singletons/Sections.ghc710.template --- a/tests/compile-and-dump/Singletons/Sections.ghc710.template +++ b/tests/compile-and-dump/Singletons/Sections.ghc710.template @@ -67,15 +67,14 @@ = let lambda :: forall m. (t ~ ZeroSym0, t ~ m) => - Sing m -> Sing (Apply (Apply (:+$) ZeroSym0) m :: Nat) + Sing m -> Sing (Apply (Apply (:+$) t) t :: Nat) lambda m = m in lambda sM (%:+) (SSucc sN) sM = let lambda :: forall n m. (t ~ Apply SuccSym0 n, t ~ m) => - Sing n - -> Sing m -> Sing (Apply (Apply (:+$) (Apply SuccSym0 n)) m :: Nat) + Sing n -> Sing m -> Sing (Apply (Apply (:+$) t) t :: Nat) lambda n m = applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) diff --git a/tests/compile-and-dump/Singletons/Sections.ghc80.template b/tests/compile-and-dump/Singletons/Sections.ghc80.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/Sections.ghc80.template @@ -0,0 +1,144 @@ +Singletons/Sections.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| (+) :: Nat -> Nat -> Nat + Zero + m = m + (Succ n) + m = Succ (n + m) + foo1 :: [Nat] + foo1 = map ((Succ Zero) +) [Zero, Succ Zero] + foo2 :: [Nat] + foo2 = map (+ (Succ Zero)) [Zero, Succ Zero] + foo3 :: [Nat] + foo3 = zipWith (+) [Succ Zero, Succ Zero] [Zero, Succ Zero] |] + ======> + (+) :: Nat -> Nat -> Nat + (+) Zero m = m + (+) (Succ n) m = Succ (n + m) + foo1 :: [Nat] + foo1 = map (Succ Zero +) [Zero, Succ Zero] + foo2 :: [Nat] + foo2 = map (+ Succ Zero) [Zero, Succ Zero] + foo3 :: [Nat] + foo3 = zipWith (+) [Succ Zero, Succ Zero] [Zero, Succ Zero] + type family Lambda_0123456789 t where + Lambda_0123456789 lhs_0123456789 = Apply (Apply (:+$) lhs_0123456789) (Apply SuccSym0 ZeroSym0) + type Lambda_0123456789Sym1 t = Lambda_0123456789 t + instance SuppressUnusedWarnings Lambda_0123456789Sym0 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Lambda_0123456789Sym0KindInference GHC.Tuple.()) + data Lambda_0123456789Sym0 l + = forall arg. KindOf (Apply Lambda_0123456789Sym0 arg) ~ KindOf (Lambda_0123456789Sym1 arg) => + Lambda_0123456789Sym0KindInference + type instance Apply Lambda_0123456789Sym0 l = Lambda_0123456789Sym1 l + type (:+$$$) (t :: Nat) (t :: Nat) = (:+) t t + instance SuppressUnusedWarnings (:+$$) where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) (:+$$###) GHC.Tuple.()) + data (:+$$) (l :: Nat) (l :: TyFun Nat Nat) + = forall arg. KindOf (Apply ((:+$$) l) arg) ~ KindOf ((:+$$$) l arg) => + (:+$$###) + type instance Apply ((:+$$) l) l = (:+$$$) l l + instance SuppressUnusedWarnings (:+$) where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) (:+$###) GHC.Tuple.()) + data (:+$) (l :: TyFun Nat (TyFun Nat Nat -> GHC.Types.Type)) + = forall arg. KindOf (Apply (:+$) arg) ~ KindOf ((:+$$) arg) => + (:+$###) + type instance Apply (:+$) l = (:+$$) l + type Foo1Sym0 = Foo1 + type Foo2Sym0 = Foo2 + type Foo3Sym0 = Foo3 + 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_0123456789Sym0) (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)) '[])) + (%:+) :: + 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 + = let + lambda :: + forall m. + (t ~ ZeroSym0, t ~ m) => + Sing m -> Sing (Apply (Apply (:+$) t) t :: Nat) + lambda m = m + in lambda sM + (%:+) (SSucc sN) sM + = let + lambda :: + forall n m. + (t ~ Apply SuccSym0 n, t ~ m) => + Sing n -> Sing m -> Sing (Apply (Apply (:+$) t) t :: Nat) + lambda n m + = applySing + (singFun1 (Proxy :: Proxy SuccSym0) SSucc) + (applySing (applySing (singFun2 (Proxy :: Proxy (:+$)) (%:+)) n) m) + in lambda sN sM + sFoo1 + = applySing + (applySing + (singFun2 (Proxy :: Proxy MapSym0) sMap) + (applySing + (singFun2 (Proxy :: Proxy (:+$)) (%:+)) + (applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) SZero))) + (applySing + (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SZero) + (applySing + (applySing + (singFun2 (Proxy :: Proxy (:$)) SCons) + (applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) SZero)) + SNil)) + sFoo2 + = applySing + (applySing + (singFun2 (Proxy :: Proxy MapSym0) sMap) + (singFun1 + (Proxy :: Proxy Lambda_0123456789Sym0) + (\ sLhs_0123456789 + -> let + lambda :: + forall lhs_0123456789. + Sing lhs_0123456789 + -> Sing (Apply Lambda_0123456789Sym0 lhs_0123456789) + lambda lhs_0123456789 + = applySing + (applySing (singFun2 (Proxy :: Proxy (:+$)) (%:+)) lhs_0123456789) + (applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) SZero) + in lambda sLhs_0123456789))) + (applySing + (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SZero) + (applySing + (applySing + (singFun2 (Proxy :: Proxy (:$)) SCons) + (applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) SZero)) + SNil)) + sFoo3 + = applySing + (applySing + (applySing + (singFun3 (Proxy :: Proxy ZipWithSym0) sZipWith) + (singFun2 (Proxy :: Proxy (:+$)) (%:+))) + (applySing + (applySing + (singFun2 (Proxy :: Proxy (:$)) SCons) + (applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) SZero)) + (applySing + (applySing + (singFun2 (Proxy :: Proxy (:$)) SCons) + (applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) SZero)) + SNil))) + (applySing + (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SZero) + (applySing + (applySing + (singFun2 (Proxy :: Proxy (:$)) SCons) + (applySing (singFun1 (Proxy :: Proxy SuccSym0) SSucc) SZero)) + SNil)) diff --git a/tests/compile-and-dump/Singletons/Star.ghc710.template b/tests/compile-and-dump/Singletons/Star.ghc710.template --- a/tests/compile-and-dump/Singletons/Star.ghc710.template +++ b/tests/compile-and-dump/Singletons/Star.ghc710.template @@ -103,7 +103,7 @@ = let lambda :: (t0 ~ NatSym0, t1 ~ NatSym0) => - Sing (Apply (Apply CompareSym0 NatSym0) NatSym0 :: Ordering) + Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda = applySing (applySing @@ -118,7 +118,7 @@ = let lambda :: (t0 ~ IntSym0, t1 ~ IntSym0) => - Sing (Apply (Apply CompareSym0 IntSym0) IntSym0 :: Ordering) + Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda = applySing (applySing @@ -133,7 +133,7 @@ = let lambda :: (t0 ~ StringSym0, t1 ~ StringSym0) => - Sing (Apply (Apply CompareSym0 StringSym0) StringSym0 :: Ordering) + Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda = applySing (applySing @@ -152,7 +152,7 @@ t1 ~ Apply MaybeSym0 b_0123456789) => Sing a_0123456789 -> Sing b_0123456789 - -> Sing (Apply (Apply CompareSym0 (Apply MaybeSym0 a_0123456789)) (Apply MaybeSym0 b_0123456789) :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda a_0123456789 b_0123456789 = applySing (applySing @@ -186,7 +186,7 @@ -> Sing a_0123456789 -> Sing b_0123456789 -> Sing b_0123456789 - -> Sing (Apply (Apply CompareSym0 (Apply (Apply VecSym0 a_0123456789) a_0123456789)) (Apply (Apply VecSym0 b_0123456789) b_0123456789) :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda a_0123456789 a_0123456789 b_0123456789 b_0123456789 = applySing (applySing @@ -219,14 +219,14 @@ = let lambda :: (t0 ~ NatSym0, t1 ~ IntSym0) => - Sing (Apply (Apply CompareSym0 NatSym0) IntSym0 :: Ordering) + Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda = SLT in lambda sCompare SNat SString = let lambda :: (t0 ~ NatSym0, t1 ~ StringSym0) => - Sing (Apply (Apply CompareSym0 NatSym0) StringSym0 :: Ordering) + Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda = SLT in lambda sCompare SNat (SMaybe _s_z_0123456789) @@ -235,7 +235,7 @@ forall _z_0123456789. (t0 ~ NatSym0, t1 ~ Apply MaybeSym0 _z_0123456789) => Sing _z_0123456789 - -> Sing (Apply (Apply CompareSym0 NatSym0) (Apply MaybeSym0 _z_0123456789) :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda _z_0123456789 = SLT in lambda _s_z_0123456789 sCompare SNat (SVec _s_z_0123456789 _s_z_0123456789) @@ -245,21 +245,21 @@ t1 ~ Apply (Apply VecSym0 _z_0123456789) _z_0123456789) => Sing _z_0123456789 -> Sing _z_0123456789 - -> Sing (Apply (Apply CompareSym0 NatSym0) (Apply (Apply VecSym0 _z_0123456789) _z_0123456789) :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda _z_0123456789 _z_0123456789 = SLT in lambda _s_z_0123456789 _s_z_0123456789 sCompare SInt SNat = let lambda :: (t0 ~ IntSym0, t1 ~ NatSym0) => - Sing (Apply (Apply CompareSym0 IntSym0) NatSym0 :: Ordering) + Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda = SGT in lambda sCompare SInt SString = let lambda :: (t0 ~ IntSym0, t1 ~ StringSym0) => - Sing (Apply (Apply CompareSym0 IntSym0) StringSym0 :: Ordering) + Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda = SLT in lambda sCompare SInt (SMaybe _s_z_0123456789) @@ -268,7 +268,7 @@ forall _z_0123456789. (t0 ~ IntSym0, t1 ~ Apply MaybeSym0 _z_0123456789) => Sing _z_0123456789 - -> Sing (Apply (Apply CompareSym0 IntSym0) (Apply MaybeSym0 _z_0123456789) :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda _z_0123456789 = SLT in lambda _s_z_0123456789 sCompare SInt (SVec _s_z_0123456789 _s_z_0123456789) @@ -278,21 +278,21 @@ t1 ~ Apply (Apply VecSym0 _z_0123456789) _z_0123456789) => Sing _z_0123456789 -> Sing _z_0123456789 - -> Sing (Apply (Apply CompareSym0 IntSym0) (Apply (Apply VecSym0 _z_0123456789) _z_0123456789) :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda _z_0123456789 _z_0123456789 = SLT in lambda _s_z_0123456789 _s_z_0123456789 sCompare SString SNat = let lambda :: (t0 ~ StringSym0, t1 ~ NatSym0) => - Sing (Apply (Apply CompareSym0 StringSym0) NatSym0 :: Ordering) + Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda = SGT in lambda sCompare SString SInt = let lambda :: (t0 ~ StringSym0, t1 ~ IntSym0) => - Sing (Apply (Apply CompareSym0 StringSym0) IntSym0 :: Ordering) + Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda = SGT in lambda sCompare SString (SMaybe _s_z_0123456789) @@ -301,7 +301,7 @@ forall _z_0123456789. (t0 ~ StringSym0, t1 ~ Apply MaybeSym0 _z_0123456789) => Sing _z_0123456789 - -> Sing (Apply (Apply CompareSym0 StringSym0) (Apply MaybeSym0 _z_0123456789) :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda _z_0123456789 = SLT in lambda _s_z_0123456789 sCompare SString (SVec _s_z_0123456789 _s_z_0123456789) @@ -311,7 +311,7 @@ t1 ~ Apply (Apply VecSym0 _z_0123456789) _z_0123456789) => Sing _z_0123456789 -> Sing _z_0123456789 - -> Sing (Apply (Apply CompareSym0 StringSym0) (Apply (Apply VecSym0 _z_0123456789) _z_0123456789) :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda _z_0123456789 _z_0123456789 = SLT in lambda _s_z_0123456789 _s_z_0123456789 sCompare (SMaybe _s_z_0123456789) SNat @@ -320,7 +320,7 @@ forall _z_0123456789. (t0 ~ Apply MaybeSym0 _z_0123456789, t1 ~ NatSym0) => Sing _z_0123456789 - -> Sing (Apply (Apply CompareSym0 (Apply MaybeSym0 _z_0123456789)) NatSym0 :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda _z_0123456789 = SGT in lambda _s_z_0123456789 sCompare (SMaybe _s_z_0123456789) SInt @@ -329,7 +329,7 @@ forall _z_0123456789. (t0 ~ Apply MaybeSym0 _z_0123456789, t1 ~ IntSym0) => Sing _z_0123456789 - -> Sing (Apply (Apply CompareSym0 (Apply MaybeSym0 _z_0123456789)) IntSym0 :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda _z_0123456789 = SGT in lambda _s_z_0123456789 sCompare (SMaybe _s_z_0123456789) SString @@ -338,7 +338,7 @@ forall _z_0123456789. (t0 ~ Apply MaybeSym0 _z_0123456789, t1 ~ StringSym0) => Sing _z_0123456789 - -> Sing (Apply (Apply CompareSym0 (Apply MaybeSym0 _z_0123456789)) StringSym0 :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda _z_0123456789 = SGT in lambda _s_z_0123456789 sCompare @@ -353,7 +353,7 @@ Sing _z_0123456789 -> Sing _z_0123456789 -> Sing _z_0123456789 - -> Sing (Apply (Apply CompareSym0 (Apply MaybeSym0 _z_0123456789)) (Apply (Apply VecSym0 _z_0123456789) _z_0123456789) :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda _z_0123456789 _z_0123456789 _z_0123456789 = SLT in lambda _s_z_0123456789 _s_z_0123456789 _s_z_0123456789 sCompare (SVec _s_z_0123456789 _s_z_0123456789) SNat @@ -364,7 +364,7 @@ t1 ~ NatSym0) => Sing _z_0123456789 -> Sing _z_0123456789 - -> Sing (Apply (Apply CompareSym0 (Apply (Apply VecSym0 _z_0123456789) _z_0123456789)) NatSym0 :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda _z_0123456789 _z_0123456789 = SGT in lambda _s_z_0123456789 _s_z_0123456789 sCompare (SVec _s_z_0123456789 _s_z_0123456789) SInt @@ -375,7 +375,7 @@ t1 ~ IntSym0) => Sing _z_0123456789 -> Sing _z_0123456789 - -> Sing (Apply (Apply CompareSym0 (Apply (Apply VecSym0 _z_0123456789) _z_0123456789)) IntSym0 :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda _z_0123456789 _z_0123456789 = SGT in lambda _s_z_0123456789 _s_z_0123456789 sCompare (SVec _s_z_0123456789 _s_z_0123456789) SString @@ -386,7 +386,7 @@ t1 ~ StringSym0) => Sing _z_0123456789 -> Sing _z_0123456789 - -> Sing (Apply (Apply CompareSym0 (Apply (Apply VecSym0 _z_0123456789) _z_0123456789)) StringSym0 :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda _z_0123456789 _z_0123456789 = SGT in lambda _s_z_0123456789 _s_z_0123456789 sCompare @@ -401,7 +401,7 @@ Sing _z_0123456789 -> Sing _z_0123456789 -> Sing _z_0123456789 - -> Sing (Apply (Apply CompareSym0 (Apply (Apply VecSym0 _z_0123456789) _z_0123456789)) (Apply MaybeSym0 _z_0123456789) :: Ordering) + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) lambda _z_0123456789 _z_0123456789 _z_0123456789 = SGT in lambda _s_z_0123456789 _s_z_0123456789 _s_z_0123456789 data instance Sing (z :: *) diff --git a/tests/compile-and-dump/Singletons/Star.ghc80.template b/tests/compile-and-dump/Singletons/Star.ghc80.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/Star.ghc80.template @@ -0,0 +1,589 @@ +Singletons/Star.hs:0:0:: Splicing declarations + singletonStar [''Nat, ''Int, ''String, ''Maybe, ''Vec] + ======> + data Rep + = Singletons.Star.Nat | + Singletons.Star.Int | + Singletons.Star.String | + Singletons.Star.Maybe Rep | + Singletons.Star.Vec Rep Nat + deriving (Eq, Show, Read) + type family Equals_0123456789 (a :: Type) (b :: Type) :: Bool where + Equals_0123456789 Nat Nat = TrueSym0 + Equals_0123456789 Int Int = TrueSym0 + Equals_0123456789 String String = TrueSym0 + Equals_0123456789 (Maybe a) (Maybe b) = (:==) a b + Equals_0123456789 (Vec a a) (Vec b b) = (:&&) ((:==) a b) ((:==) a b) + Equals_0123456789 (a :: Type) (b :: Type) = FalseSym0 + instance PEq (KProxy :: KProxy Type) where + type (:==) (a :: Type) (b :: Type) = Equals_0123456789 a b + type NatSym0 = Nat + type IntSym0 = Int + type StringSym0 = String + type MaybeSym1 (t :: Type) = Maybe t + instance Data.Singletons.SuppressUnusedWarnings.SuppressUnusedWarnings MaybeSym0 where + Data.Singletons.SuppressUnusedWarnings.suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) MaybeSym0KindInference GHC.Tuple.()) + data MaybeSym0 (l :: TyFun Type Type) + = forall arg. KindOf (Apply MaybeSym0 arg) ~ KindOf (MaybeSym1 arg) => + MaybeSym0KindInference + type instance Apply MaybeSym0 l = MaybeSym1 l + type VecSym2 (t :: Type) (t :: Nat) = Vec t t + instance Data.Singletons.SuppressUnusedWarnings.SuppressUnusedWarnings VecSym1 where + Data.Singletons.SuppressUnusedWarnings.suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) VecSym1KindInference GHC.Tuple.()) + data VecSym1 (l :: Type) (l :: TyFun Nat Type) + = forall arg. KindOf (Apply (VecSym1 l) arg) ~ KindOf (VecSym2 l arg) => + VecSym1KindInference + type instance Apply (VecSym1 l) l = VecSym2 l l + instance Data.Singletons.SuppressUnusedWarnings.SuppressUnusedWarnings VecSym0 where + Data.Singletons.SuppressUnusedWarnings.suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) VecSym0KindInference GHC.Tuple.()) + data VecSym0 (l :: TyFun Type (TyFun Nat Type -> Type)) + = forall arg. KindOf (Apply VecSym0 arg) ~ KindOf (VecSym1 arg) => + VecSym0KindInference + type instance Apply VecSym0 l = VecSym1 l + type family Compare_0123456789 (a :: Type) + (a :: Type) :: Ordering where + Compare_0123456789 Nat Nat = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] + Compare_0123456789 Int Int = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] + Compare_0123456789 String String = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] + Compare_0123456789 (Maybe a_0123456789) (Maybe b_0123456789) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) '[]) + Compare_0123456789 (Vec a_0123456789 a_0123456789) (Vec b_0123456789 b_0123456789) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) (Apply (Apply (:$) (Apply (Apply CompareSym0 a_0123456789) b_0123456789)) '[])) + Compare_0123456789 Nat Int = LTSym0 + Compare_0123456789 Nat String = LTSym0 + Compare_0123456789 Nat (Maybe _z_0123456789) = LTSym0 + Compare_0123456789 Nat (Vec _z_0123456789 _z_0123456789) = LTSym0 + Compare_0123456789 Int Nat = GTSym0 + Compare_0123456789 Int String = LTSym0 + Compare_0123456789 Int (Maybe _z_0123456789) = LTSym0 + Compare_0123456789 Int (Vec _z_0123456789 _z_0123456789) = LTSym0 + Compare_0123456789 String Nat = GTSym0 + Compare_0123456789 String Int = GTSym0 + Compare_0123456789 String (Maybe _z_0123456789) = LTSym0 + Compare_0123456789 String (Vec _z_0123456789 _z_0123456789) = LTSym0 + Compare_0123456789 (Maybe _z_0123456789) Nat = GTSym0 + Compare_0123456789 (Maybe _z_0123456789) Int = GTSym0 + Compare_0123456789 (Maybe _z_0123456789) String = GTSym0 + Compare_0123456789 (Maybe _z_0123456789) (Vec _z_0123456789 _z_0123456789) = LTSym0 + Compare_0123456789 (Vec _z_0123456789 _z_0123456789) Nat = GTSym0 + Compare_0123456789 (Vec _z_0123456789 _z_0123456789) Int = GTSym0 + Compare_0123456789 (Vec _z_0123456789 _z_0123456789) String = GTSym0 + Compare_0123456789 (Vec _z_0123456789 _z_0123456789) (Maybe _z_0123456789) = GTSym0 + type Compare_0123456789Sym2 (t :: Type) (t :: Type) = + Compare_0123456789 t t + instance Data.Singletons.SuppressUnusedWarnings.SuppressUnusedWarnings Compare_0123456789Sym1 where + Data.Singletons.SuppressUnusedWarnings.suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Compare_0123456789Sym1KindInference GHC.Tuple.()) + data Compare_0123456789Sym1 (l :: Type) (l :: TyFun Type Ordering) + = forall arg. KindOf (Apply (Compare_0123456789Sym1 l) arg) ~ KindOf (Compare_0123456789Sym2 l arg) => + Compare_0123456789Sym1KindInference + type instance Apply (Compare_0123456789Sym1 l) l = Compare_0123456789Sym2 l l + instance Data.Singletons.SuppressUnusedWarnings.SuppressUnusedWarnings Compare_0123456789Sym0 where + Data.Singletons.SuppressUnusedWarnings.suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) Compare_0123456789Sym0KindInference GHC.Tuple.()) + data Compare_0123456789Sym0 (l :: TyFun Type (TyFun Type Ordering + -> Type)) + = forall arg. KindOf (Apply Compare_0123456789Sym0 arg) ~ KindOf (Compare_0123456789Sym1 arg) => + Compare_0123456789Sym0KindInference + type instance Apply Compare_0123456789Sym0 l = Compare_0123456789Sym1 l + instance POrd (KProxy :: KProxy Type) where + type Compare (a :: Type) (a :: Type) = Apply (Apply Compare_0123456789Sym0 a) a + instance (SOrd (KProxy :: KProxy Type), + SOrd (KProxy :: KProxy Nat)) => + SOrd (KProxy :: KProxy Type) where + sCompare :: + forall (t0 :: Type) (t1 :: Type). + Sing t0 + -> Sing t1 + -> Sing (Apply (Apply (CompareSym0 :: TyFun Type (TyFun Type Ordering + -> Type) + -> Type) t0 :: TyFun Type Ordering + -> Type) t1 :: Ordering) + sCompare SNat SNat + = let + lambda :: + (t0 ~ NatSym0, t1 ~ NatSym0) => + Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda + = applySing + (applySing + (applySing + (singFun3 (Data.Proxy.Proxy :: Data.Proxy.Proxy FoldlSym0) sFoldl) + (singFun2 + (Data.Proxy.Proxy :: Data.Proxy.Proxy ThenCmpSym0) sThenCmp)) + SEQ) + SNil + in lambda + sCompare SInt SInt + = let + lambda :: + (t0 ~ IntSym0, t1 ~ IntSym0) => + Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda + = applySing + (applySing + (applySing + (singFun3 (Data.Proxy.Proxy :: Data.Proxy.Proxy FoldlSym0) sFoldl) + (singFun2 + (Data.Proxy.Proxy :: Data.Proxy.Proxy ThenCmpSym0) sThenCmp)) + SEQ) + SNil + in lambda + sCompare SString SString + = let + lambda :: + (t0 ~ StringSym0, t1 ~ StringSym0) => + Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda + = applySing + (applySing + (applySing + (singFun3 (Data.Proxy.Proxy :: Data.Proxy.Proxy FoldlSym0) sFoldl) + (singFun2 + (Data.Proxy.Proxy :: Data.Proxy.Proxy ThenCmpSym0) sThenCmp)) + SEQ) + SNil + in lambda + sCompare (SMaybe sA_0123456789) (SMaybe sB_0123456789) + = let + lambda :: + forall a_0123456789 b_0123456789. + (t0 ~ Apply MaybeSym0 a_0123456789, + t1 ~ Apply MaybeSym0 b_0123456789) => + Sing a_0123456789 + -> Sing b_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda a_0123456789 b_0123456789 + = applySing + (applySing + (applySing + (singFun3 (Data.Proxy.Proxy :: Data.Proxy.Proxy FoldlSym0) sFoldl) + (singFun2 + (Data.Proxy.Proxy :: Data.Proxy.Proxy ThenCmpSym0) sThenCmp)) + SEQ) + (applySing + (applySing + (singFun2 (Data.Proxy.Proxy :: Data.Proxy.Proxy (:$)) SCons) + (applySing + (applySing + (singFun2 + (Data.Proxy.Proxy :: Data.Proxy.Proxy CompareSym0) sCompare) + a_0123456789) + b_0123456789)) + SNil) + in lambda sA_0123456789 sB_0123456789 + sCompare + (SVec sA_0123456789 sA_0123456789) + (SVec sB_0123456789 sB_0123456789) + = let + lambda :: + forall a_0123456789 a_0123456789 b_0123456789 b_0123456789. + (t0 ~ Apply (Apply VecSym0 a_0123456789) a_0123456789, + t1 ~ Apply (Apply VecSym0 b_0123456789) b_0123456789) => + Sing a_0123456789 + -> Sing a_0123456789 + -> Sing b_0123456789 + -> Sing b_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda a_0123456789 a_0123456789 b_0123456789 b_0123456789 + = applySing + (applySing + (applySing + (singFun3 (Data.Proxy.Proxy :: Data.Proxy.Proxy FoldlSym0) sFoldl) + (singFun2 + (Data.Proxy.Proxy :: Data.Proxy.Proxy ThenCmpSym0) sThenCmp)) + SEQ) + (applySing + (applySing + (singFun2 (Data.Proxy.Proxy :: Data.Proxy.Proxy (:$)) SCons) + (applySing + (applySing + (singFun2 + (Data.Proxy.Proxy :: Data.Proxy.Proxy CompareSym0) sCompare) + a_0123456789) + b_0123456789)) + (applySing + (applySing + (singFun2 (Data.Proxy.Proxy :: Data.Proxy.Proxy (:$)) SCons) + (applySing + (applySing + (singFun2 + (Data.Proxy.Proxy :: Data.Proxy.Proxy CompareSym0) sCompare) + a_0123456789) + b_0123456789)) + SNil)) + in lambda sA_0123456789 sA_0123456789 sB_0123456789 sB_0123456789 + sCompare SNat SInt + = let + lambda :: + (t0 ~ NatSym0, t1 ~ IntSym0) => + Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda = SLT + in lambda + sCompare SNat SString + = let + lambda :: + (t0 ~ NatSym0, t1 ~ StringSym0) => + Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda = SLT + in lambda + sCompare SNat (SMaybe _s_z_0123456789) + = let + lambda :: + forall _z_0123456789. + (t0 ~ NatSym0, t1 ~ Apply MaybeSym0 _z_0123456789) => + Sing _z_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda _z_0123456789 = SLT + in lambda _s_z_0123456789 + sCompare SNat (SVec _s_z_0123456789 _s_z_0123456789) + = let + lambda :: + forall _z_0123456789 _z_0123456789. + (t0 ~ NatSym0, + t1 ~ Apply (Apply VecSym0 _z_0123456789) _z_0123456789) => + Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda _z_0123456789 _z_0123456789 = SLT + in lambda _s_z_0123456789 _s_z_0123456789 + sCompare SInt SNat + = let + lambda :: + (t0 ~ IntSym0, t1 ~ NatSym0) => + Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda = SGT + in lambda + sCompare SInt SString + = let + lambda :: + (t0 ~ IntSym0, t1 ~ StringSym0) => + Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda = SLT + in lambda + sCompare SInt (SMaybe _s_z_0123456789) + = let + lambda :: + forall _z_0123456789. + (t0 ~ IntSym0, t1 ~ Apply MaybeSym0 _z_0123456789) => + Sing _z_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda _z_0123456789 = SLT + in lambda _s_z_0123456789 + sCompare SInt (SVec _s_z_0123456789 _s_z_0123456789) + = let + lambda :: + forall _z_0123456789 _z_0123456789. + (t0 ~ IntSym0, + t1 ~ Apply (Apply VecSym0 _z_0123456789) _z_0123456789) => + Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda _z_0123456789 _z_0123456789 = SLT + in lambda _s_z_0123456789 _s_z_0123456789 + sCompare SString SNat + = let + lambda :: + (t0 ~ StringSym0, t1 ~ NatSym0) => + Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda = SGT + in lambda + sCompare SString SInt + = let + lambda :: + (t0 ~ StringSym0, t1 ~ IntSym0) => + Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda = SGT + in lambda + sCompare SString (SMaybe _s_z_0123456789) + = let + lambda :: + forall _z_0123456789. + (t0 ~ StringSym0, t1 ~ Apply MaybeSym0 _z_0123456789) => + Sing _z_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda _z_0123456789 = SLT + in lambda _s_z_0123456789 + sCompare SString (SVec _s_z_0123456789 _s_z_0123456789) + = let + lambda :: + forall _z_0123456789 _z_0123456789. + (t0 ~ StringSym0, + t1 ~ Apply (Apply VecSym0 _z_0123456789) _z_0123456789) => + Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda _z_0123456789 _z_0123456789 = SLT + in lambda _s_z_0123456789 _s_z_0123456789 + sCompare (SMaybe _s_z_0123456789) SNat + = let + lambda :: + forall _z_0123456789. + (t0 ~ Apply MaybeSym0 _z_0123456789, t1 ~ NatSym0) => + Sing _z_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda _z_0123456789 = SGT + in lambda _s_z_0123456789 + sCompare (SMaybe _s_z_0123456789) SInt + = let + lambda :: + forall _z_0123456789. + (t0 ~ Apply MaybeSym0 _z_0123456789, t1 ~ IntSym0) => + Sing _z_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda _z_0123456789 = SGT + in lambda _s_z_0123456789 + sCompare (SMaybe _s_z_0123456789) SString + = let + lambda :: + forall _z_0123456789. + (t0 ~ Apply MaybeSym0 _z_0123456789, t1 ~ StringSym0) => + Sing _z_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda _z_0123456789 = SGT + in lambda _s_z_0123456789 + sCompare + (SMaybe _s_z_0123456789) + (SVec _s_z_0123456789 _s_z_0123456789) + = let + lambda :: + forall _z_0123456789 _z_0123456789 _z_0123456789. + (t0 ~ Apply MaybeSym0 _z_0123456789, + t1 ~ Apply (Apply VecSym0 _z_0123456789) _z_0123456789) => + Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda _z_0123456789 _z_0123456789 _z_0123456789 = SLT + in lambda _s_z_0123456789 _s_z_0123456789 _s_z_0123456789 + sCompare (SVec _s_z_0123456789 _s_z_0123456789) SNat + = let + lambda :: + forall _z_0123456789 _z_0123456789. + (t0 ~ Apply (Apply VecSym0 _z_0123456789) _z_0123456789, + t1 ~ NatSym0) => + Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda _z_0123456789 _z_0123456789 = SGT + in lambda _s_z_0123456789 _s_z_0123456789 + sCompare (SVec _s_z_0123456789 _s_z_0123456789) SInt + = let + lambda :: + forall _z_0123456789 _z_0123456789. + (t0 ~ Apply (Apply VecSym0 _z_0123456789) _z_0123456789, + t1 ~ IntSym0) => + Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda _z_0123456789 _z_0123456789 = SGT + in lambda _s_z_0123456789 _s_z_0123456789 + sCompare (SVec _s_z_0123456789 _s_z_0123456789) SString + = let + lambda :: + forall _z_0123456789 _z_0123456789. + (t0 ~ Apply (Apply VecSym0 _z_0123456789) _z_0123456789, + t1 ~ StringSym0) => + Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda _z_0123456789 _z_0123456789 = SGT + in lambda _s_z_0123456789 _s_z_0123456789 + sCompare + (SVec _s_z_0123456789 _s_z_0123456789) + (SMaybe _s_z_0123456789) + = let + lambda :: + forall _z_0123456789 _z_0123456789 _z_0123456789. + (t0 ~ Apply (Apply VecSym0 _z_0123456789) _z_0123456789, + t1 ~ Apply MaybeSym0 _z_0123456789) => + Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing _z_0123456789 + -> Sing (Apply (Apply CompareSym0 t0) t1 :: Ordering) + lambda _z_0123456789 _z_0123456789 _z_0123456789 = SGT + in lambda _s_z_0123456789 _s_z_0123456789 _s_z_0123456789 + data instance Sing (z :: Type) + = z ~ Nat => SNat | + z ~ Int => SInt | + z ~ String => SString | + forall (n :: Type). z ~ Maybe n => SMaybe (Sing (n :: Type)) | + forall (n :: Type) (n :: Nat). z ~ Vec n n => + SVec (Sing (n :: Type)) (Sing (n :: Nat)) + type SRep = (Sing :: Type -> Type) + instance SingKind (KProxy :: KProxy Type) where + type DemoteRep (KProxy :: KProxy Type) = Rep + fromSing SNat = Singletons.Star.Nat + fromSing SInt = Singletons.Star.Int + fromSing SString = Singletons.Star.String + fromSing (SMaybe b) = Singletons.Star.Maybe (fromSing b) + fromSing (SVec b b) = Singletons.Star.Vec (fromSing b) (fromSing b) + toSing Singletons.Star.Nat = SomeSing SNat + toSing Singletons.Star.Int = SomeSing SInt + toSing Singletons.Star.String = SomeSing SString + toSing (Singletons.Star.Maybe b) + = case toSing b :: SomeSing (KProxy :: KProxy Type) of { + SomeSing c -> SomeSing (SMaybe c) } + toSing (Singletons.Star.Vec b b) + = case + GHC.Tuple.(,) + (toSing b :: SomeSing (KProxy :: KProxy Type)) + (toSing b :: SomeSing (KProxy :: KProxy Nat)) + of { + GHC.Tuple.(,) (SomeSing c) (SomeSing c) -> SomeSing (SVec c c) } + instance SEq (KProxy :: KProxy Type) where + (%:==) SNat SNat = STrue + (%:==) SNat SInt = SFalse + (%:==) SNat SString = SFalse + (%:==) SNat (SMaybe _) = SFalse + (%:==) SNat (SVec _ _) = SFalse + (%:==) SInt SNat = SFalse + (%:==) SInt SInt = STrue + (%:==) SInt SString = SFalse + (%:==) SInt (SMaybe _) = SFalse + (%:==) SInt (SVec _ _) = SFalse + (%:==) SString SNat = SFalse + (%:==) SString SInt = SFalse + (%:==) SString SString = STrue + (%:==) SString (SMaybe _) = SFalse + (%:==) SString (SVec _ _) = SFalse + (%:==) (SMaybe _) SNat = SFalse + (%:==) (SMaybe _) SInt = SFalse + (%:==) (SMaybe _) SString = SFalse + (%:==) (SMaybe a) (SMaybe b) = (%:==) a b + (%:==) (SMaybe _) (SVec _ _) = SFalse + (%:==) (SVec _ _) SNat = SFalse + (%:==) (SVec _ _) SInt = SFalse + (%:==) (SVec _ _) SString = SFalse + (%:==) (SVec _ _) (SMaybe _) = SFalse + (%:==) (SVec a a) (SVec b b) = (%:&&) ((%:==) a b) ((%:==) a b) + instance SDecide (KProxy :: KProxy Type) where + (%~) SNat SNat = Proved Refl + (%~) SNat SInt + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SNat SString + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SNat (SMaybe _) + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SNat (SVec _ _) + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SInt SNat + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SInt SInt = Proved Refl + (%~) SInt SString + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SInt (SMaybe _) + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SInt (SVec _ _) + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SString SNat + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SString SInt + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SString SString = Proved Refl + (%~) SString (SMaybe _) + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) SString (SVec _ _) + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) (SMaybe _) SNat + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) (SMaybe _) SInt + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) (SMaybe _) SString + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) (SMaybe a) (SMaybe b) + = case (%~) a b of { + Proved Refl -> Proved Refl + Disproved contra + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) } + (%~) (SMaybe _) (SVec _ _) + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) (SVec _ _) SNat + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) (SVec _ _) SInt + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) (SVec _ _) SString + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) (SVec _ _) (SMaybe _) + = Disproved + (\ x + -> case x of { + _ -> error "Empty case reached -- this should be impossible" }) + (%~) (SVec a a) (SVec b b) + = case GHC.Tuple.(,) ((%~) a b) ((%~) a b) of { + GHC.Tuple.(,) (Proved Refl) (Proved Refl) -> Proved Refl + GHC.Tuple.(,) (Disproved contra) _ + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) + GHC.Tuple.(,) _ (Disproved contra) + -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) } + instance SingI Nat where + sing = SNat + instance SingI Int where + sing = SInt + instance SingI String where + sing = SString + instance SingI n => SingI (Maybe (n :: Type)) where + sing = SMaybe sing + instance (SingI n, SingI n) => + SingI (Vec (n :: Type) (n :: Nat)) where + sing = SVec sing sing diff --git a/tests/compile-and-dump/Singletons/Star.hs b/tests/compile-and-dump/Singletons/Star.hs --- a/tests/compile-and-dump/Singletons/Star.hs +++ b/tests/compile-and-dump/Singletons/Star.hs @@ -7,6 +7,10 @@ import Data.Singletons.CustomStar import Singletons.Nat +#if __GLASGOW_HASKELL__ >= 711 +import Data.Kind +#endif + data Vec :: * -> Nat -> * where VNil :: Vec a Zero VCons :: a -> Vec a n -> Vec a (Succ n) diff --git a/tests/compile-and-dump/Singletons/T124.ghc710.template b/tests/compile-and-dump/Singletons/T124.ghc710.template --- a/tests/compile-and-dump/Singletons/T124.ghc710.template +++ b/tests/compile-and-dump/Singletons/T124.ghc710.template @@ -21,12 +21,12 @@ sFoo :: forall (t :: Bool). Sing t -> Sing (Apply FooSym0 t :: ()) sFoo STrue = let - lambda :: t ~ TrueSym0 => Sing (Apply FooSym0 TrueSym0 :: ()) + lambda :: t ~ TrueSym0 => Sing (Apply FooSym0 t :: ()) lambda = STuple0 in lambda sFoo SFalse = let - lambda :: t ~ FalseSym0 => Sing (Apply FooSym0 FalseSym0 :: ()) + lambda :: t ~ FalseSym0 => Sing (Apply FooSym0 t :: ()) lambda = STuple0 in lambda Singletons/T124.hs:0:0:: Splicing expression diff --git a/tests/compile-and-dump/Singletons/T124.ghc80.template b/tests/compile-and-dump/Singletons/T124.ghc80.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T124.ghc80.template @@ -0,0 +1,37 @@ +Singletons/T124.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| foo :: Bool -> () + foo True = () + foo False = () |] + ======> + foo :: Bool -> () + foo True = GHC.Tuple.() + foo False = GHC.Tuple.() + type FooSym1 (t :: Bool) = Foo t + instance SuppressUnusedWarnings FooSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) FooSym0KindInference GHC.Tuple.()) + data FooSym0 (l :: TyFun Bool ()) + = forall arg. KindOf (Apply FooSym0 arg) ~ KindOf (FooSym1 arg) => + FooSym0KindInference + type instance Apply FooSym0 l = FooSym1 l + type family Foo (a :: Bool) :: () where + Foo True = Tuple0Sym0 + Foo False = Tuple0Sym0 + sFoo :: forall (t :: Bool). Sing t -> Sing (Apply FooSym0 t :: ()) + sFoo STrue + = let + lambda :: t ~ TrueSym0 => Sing (Apply FooSym0 t :: ()) + lambda = STuple0 + in lambda + sFoo SFalse + = let + lambda :: t ~ FalseSym0 => Sing (Apply FooSym0 t :: ()) + lambda = STuple0 + in lambda +Singletons/T124.hs:0:0:: Splicing expression + sCases ''Bool [| b |] [| STuple0 |] + ======> + case b of { + SFalse -> STuple0 + STrue -> STuple0 } diff --git a/tests/compile-and-dump/Singletons/T136.ghc710.template b/tests/compile-and-dump/Singletons/T136.ghc710.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T136.ghc710.template @@ -0,0 +1,262 @@ +Singletons/T136.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| instance Enum BiNat where + succ [] = [True] + succ (False : as) = True : as + succ (True : as) = False : succ as + pred [] = error "pred 0" + pred (False : as) = True : pred as + pred (True : as) = False : as + toEnum i + | i < 0 = error "negative toEnum" + | i == 0 = [] + | otherwise = succ (toEnum (pred i)) + fromEnum [] = 0 + fromEnum (False : as) = 2 * fromEnum as + fromEnum (True : as) = 1 + 2 * fromEnum as |] + ======> + instance Enum BiNat where + succ GHC.Types.[] = [True] + succ (False GHC.Types.: as) = (True GHC.Types.: as) + succ (True GHC.Types.: as) = (False GHC.Types.: (succ as)) + pred GHC.Types.[] = error "pred 0" + pred (False GHC.Types.: as) = (True GHC.Types.: (pred as)) + pred (True GHC.Types.: as) = (False GHC.Types.: as) + toEnum i + | (i < 0) = error "negative toEnum" + | (i == 0) = [] + | otherwise = succ (toEnum (pred i)) + fromEnum GHC.Types.[] = 0 + fromEnum (False GHC.Types.: as) = (2 * (fromEnum as)) + fromEnum (True GHC.Types.: as) = (1 + (2 * (fromEnum as))) + type family Succ_0123456789 (a :: [Bool]) :: [Bool] where + Succ_0123456789 '[] = Apply (Apply (:$) TrueSym0) '[] + Succ_0123456789 ((:) False as) = Apply (Apply (:$) TrueSym0) as + Succ_0123456789 ((:) True as) = Apply (Apply (:$) FalseSym0) (Apply SuccSym0 as) + type Succ_0123456789Sym1 (t :: [Bool]) = Succ_0123456789 t + instance SuppressUnusedWarnings Succ_0123456789Sym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Succ_0123456789Sym0KindInference GHC.Tuple.()) + data Succ_0123456789Sym0 (l :: TyFun [Bool] [Bool]) + = forall arg. KindOf (Apply Succ_0123456789Sym0 arg) ~ KindOf (Succ_0123456789Sym1 arg) => + Succ_0123456789Sym0KindInference + type instance Apply Succ_0123456789Sym0 l = Succ_0123456789Sym1 l + type family Pred_0123456789 (a :: [Bool]) :: [Bool] where + Pred_0123456789 '[] = Apply ErrorSym0 "pred 0" + Pred_0123456789 ((:) False as) = Apply (Apply (:$) TrueSym0) (Apply PredSym0 as) + Pred_0123456789 ((:) True as) = Apply (Apply (:$) FalseSym0) as + type Pred_0123456789Sym1 (t :: [Bool]) = Pred_0123456789 t + instance SuppressUnusedWarnings Pred_0123456789Sym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Pred_0123456789Sym0KindInference GHC.Tuple.()) + data Pred_0123456789Sym0 (l :: TyFun [Bool] [Bool]) + = forall arg. KindOf (Apply Pred_0123456789Sym0 arg) ~ KindOf (Pred_0123456789Sym1 arg) => + Pred_0123456789Sym0KindInference + type instance Apply Pred_0123456789Sym0 l = Pred_0123456789Sym1 l + type family Case_0123456789 i arg_0123456789 t where + Case_0123456789 i arg_0123456789 True = '[] + Case_0123456789 i arg_0123456789 False = Apply SuccSym0 (Apply ToEnumSym0 (Apply PredSym0 i)) + type family Case_0123456789 i arg_0123456789 t where + Case_0123456789 i arg_0123456789 True = Apply ErrorSym0 "negative toEnum" + Case_0123456789 i arg_0123456789 False = Case_0123456789 i arg_0123456789 (Apply (Apply (:==$) i) (FromInteger 0)) + type family Case_0123456789 arg_0123456789 t where + Case_0123456789 arg_0123456789 i = Case_0123456789 i arg_0123456789 (Apply (Apply (:<$) i) (FromInteger 0)) + type family ToEnum_0123456789 (a :: GHC.TypeLits.Nat) :: [Bool] where + ToEnum_0123456789 arg_0123456789 = Case_0123456789 arg_0123456789 arg_0123456789 + type ToEnum_0123456789Sym1 (t :: GHC.TypeLits.Nat) = + ToEnum_0123456789 t + instance SuppressUnusedWarnings ToEnum_0123456789Sym0 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) ToEnum_0123456789Sym0KindInference GHC.Tuple.()) + data ToEnum_0123456789Sym0 (l :: TyFun GHC.TypeLits.Nat [Bool]) + = forall arg. KindOf (Apply ToEnum_0123456789Sym0 arg) ~ KindOf (ToEnum_0123456789Sym1 arg) => + ToEnum_0123456789Sym0KindInference + type instance Apply ToEnum_0123456789Sym0 l = ToEnum_0123456789Sym1 l + type family FromEnum_0123456789 (a :: [Bool]) :: GHC.TypeLits.Nat where + FromEnum_0123456789 '[] = FromInteger 0 + FromEnum_0123456789 ((:) False as) = Apply (Apply (:*$) (FromInteger 2)) (Apply FromEnumSym0 as) + FromEnum_0123456789 ((:) True as) = Apply (Apply (:+$) (FromInteger 1)) (Apply (Apply (:*$) (FromInteger 2)) (Apply FromEnumSym0 as)) + type FromEnum_0123456789Sym1 (t :: [Bool]) = FromEnum_0123456789 t + instance SuppressUnusedWarnings FromEnum_0123456789Sym0 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) FromEnum_0123456789Sym0KindInference GHC.Tuple.()) + data FromEnum_0123456789Sym0 (l :: TyFun [Bool] GHC.TypeLits.Nat) + = forall arg. KindOf (Apply FromEnum_0123456789Sym0 arg) ~ KindOf (FromEnum_0123456789Sym1 arg) => + FromEnum_0123456789Sym0KindInference + type instance Apply FromEnum_0123456789Sym0 l = FromEnum_0123456789Sym1 l + instance PEnum (KProxy :: KProxy [Bool]) where + type Succ (a :: [Bool]) = Apply Succ_0123456789Sym0 a + type Pred (a :: [Bool]) = Apply Pred_0123456789Sym0 a + type ToEnum (a :: GHC.TypeLits.Nat) = Apply ToEnum_0123456789Sym0 a + type FromEnum (a :: [Bool]) = Apply FromEnum_0123456789Sym0 a + instance SEnum (KProxy :: KProxy [Bool]) where + sSucc :: + forall (t0 :: [Bool]). + Sing t0 + -> Sing (Apply (SuccSym0 :: TyFun [Bool] [Bool] -> *) t0 :: [Bool]) + sPred :: + forall (t0 :: [Bool]). + Sing t0 + -> Sing (Apply (PredSym0 :: TyFun [Bool] [Bool] -> *) t0 :: [Bool]) + sToEnum :: + forall (t0 :: GHC.TypeLits.Nat). + Sing t0 + -> Sing (Apply (ToEnumSym0 :: TyFun GHC.TypeLits.Nat [Bool] + -> *) t0 :: [Bool]) + sFromEnum :: + forall (t0 :: [Bool]). + Sing t0 + -> Sing (Apply (FromEnumSym0 :: TyFun [Bool] GHC.TypeLits.Nat + -> *) t0 :: GHC.TypeLits.Nat) + sSucc SNil + = let + lambda :: t0 ~ '[] => Sing (Apply SuccSym0 t0 :: [Bool]) + lambda + = applySing + (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) STrue) SNil + in lambda + sSucc (SCons SFalse sAs) + = let + lambda :: + forall as. t0 ~ Apply (Apply (:$) FalseSym0) as => + Sing as -> Sing (Apply SuccSym0 t0 :: [Bool]) + lambda as + = applySing + (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) STrue) as + in lambda sAs + sSucc (SCons STrue sAs) + = let + lambda :: + forall as. t0 ~ Apply (Apply (:$) TrueSym0) as => + Sing as -> Sing (Apply SuccSym0 t0 :: [Bool]) + lambda as + = applySing + (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SFalse) + (applySing (singFun1 (Proxy :: Proxy SuccSym0) sSucc) as) + in lambda sAs + sPred SNil + = let + lambda :: t0 ~ '[] => Sing (Apply PredSym0 t0 :: [Bool]) + lambda = sError (sing :: Sing "pred 0") + in lambda + sPred (SCons SFalse sAs) + = let + lambda :: + forall as. t0 ~ Apply (Apply (:$) FalseSym0) as => + Sing as -> Sing (Apply PredSym0 t0 :: [Bool]) + lambda as + = applySing + (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) STrue) + (applySing (singFun1 (Proxy :: Proxy PredSym0) sPred) as) + in lambda sAs + sPred (SCons STrue sAs) + = let + lambda :: + forall as. t0 ~ Apply (Apply (:$) TrueSym0) as => + Sing as -> Sing (Apply PredSym0 t0 :: [Bool]) + lambda as + = applySing + (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SFalse) as + in lambda sAs + sToEnum sArg_0123456789 + = let + lambda :: + forall arg_0123456789. t0 ~ arg_0123456789 => + Sing arg_0123456789 -> Sing (Apply ToEnumSym0 t0 :: [Bool]) + lambda arg_0123456789 + = case arg_0123456789 of { + sI + -> let + lambda :: + forall i. i ~ arg_0123456789 => + Sing i -> Sing (Case_0123456789 arg_0123456789 i :: [Bool]) + lambda i + = case + applySing + (applySing (singFun2 (Proxy :: Proxy (:<$)) (%:<)) i) + (sFromInteger (sing :: Sing 0)) + of { + STrue + -> let + lambda :: + TrueSym0 ~ Apply (Apply (:<$) i) (FromInteger 0) => + Sing (Case_0123456789 i arg_0123456789 TrueSym0 :: [Bool]) + lambda = sError (sing :: Sing "negative toEnum") + in lambda + SFalse + -> let + lambda :: + FalseSym0 ~ Apply (Apply (:<$) i) (FromInteger 0) => + Sing (Case_0123456789 i arg_0123456789 FalseSym0 :: [Bool]) + lambda + = case + applySing + (applySing + (singFun2 (Proxy :: Proxy (:==$)) (%:==)) i) + (sFromInteger (sing :: Sing 0)) + of { + STrue + -> let + lambda :: + TrueSym0 ~ Apply (Apply (:==$) i) (FromInteger 0) => + Sing (Case_0123456789 i arg_0123456789 TrueSym0 :: [Bool]) + lambda = SNil + in lambda + SFalse + -> let + lambda :: + FalseSym0 ~ Apply (Apply (:==$) i) (FromInteger 0) => + Sing (Case_0123456789 i arg_0123456789 FalseSym0 :: [Bool]) + lambda + = applySing + (singFun1 (Proxy :: Proxy SuccSym0) sSucc) + (applySing + (singFun1 + (Proxy :: Proxy ToEnumSym0) sToEnum) + (applySing + (singFun1 + (Proxy :: Proxy PredSym0) sPred) + i)) + in lambda } :: + Sing (Case_0123456789 i arg_0123456789 (Apply (Apply (:==$) i) (FromInteger 0)) :: [Bool]) + in lambda } :: + Sing (Case_0123456789 i arg_0123456789 (Apply (Apply (:<$) i) (FromInteger 0)) :: [Bool]) + in lambda sI } :: + Sing (Case_0123456789 arg_0123456789 arg_0123456789 :: [Bool]) + in lambda sArg_0123456789 + sFromEnum SNil + = let + lambda :: + t0 ~ '[] => Sing (Apply FromEnumSym0 t0 :: GHC.TypeLits.Nat) + lambda = sFromInteger (sing :: Sing 0) + in lambda + sFromEnum (SCons SFalse sAs) + = let + lambda :: + forall as. t0 ~ Apply (Apply (:$) FalseSym0) as => + Sing as -> Sing (Apply FromEnumSym0 t0 :: GHC.TypeLits.Nat) + lambda as + = applySing + (applySing + (singFun2 (Proxy :: Proxy (:*$)) (%:*)) + (sFromInteger (sing :: Sing 2))) + (applySing (singFun1 (Proxy :: Proxy FromEnumSym0) sFromEnum) as) + in lambda sAs + sFromEnum (SCons STrue sAs) + = let + lambda :: + forall as. t0 ~ Apply (Apply (:$) TrueSym0) as => + Sing as -> Sing (Apply FromEnumSym0 t0 :: GHC.TypeLits.Nat) + lambda as + = applySing + (applySing + (singFun2 (Proxy :: Proxy (:+$)) (%:+)) + (sFromInteger (sing :: Sing 1))) + (applySing + (applySing + (singFun2 (Proxy :: Proxy (:*$)) (%:*)) + (sFromInteger (sing :: Sing 2))) + (applySing (singFun1 (Proxy :: Proxy FromEnumSym0) sFromEnum) as)) + in lambda sAs diff --git a/tests/compile-and-dump/Singletons/T136.ghc80.template b/tests/compile-and-dump/Singletons/T136.ghc80.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T136.ghc80.template @@ -0,0 +1,271 @@ +Singletons/T136.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| instance Enum BiNat where + succ [] = [True] + succ (False : as) = True : as + succ (True : as) = False : succ as + pred [] = error "pred 0" + pred (False : as) = True : pred as + pred (True : as) = False : as + toEnum i + | i < 0 = error "negative toEnum" + | i == 0 = [] + | otherwise = succ (toEnum (pred i)) + fromEnum [] = 0 + fromEnum (False : as) = 2 * fromEnum as + fromEnum (True : as) = 1 + 2 * fromEnum as |] + ======> + instance Enum BiNat where + succ GHC.Types.[] = [True] + succ (False GHC.Types.: as) = (True GHC.Types.: as) + succ (True GHC.Types.: as) = (False GHC.Types.: (succ as)) + pred GHC.Types.[] = error "pred 0" + pred (False GHC.Types.: as) = (True GHC.Types.: (pred as)) + pred (True GHC.Types.: as) = (False GHC.Types.: as) + toEnum i + | (i < 0) = error "negative toEnum" + | (i == 0) = [] + | otherwise = succ (toEnum (pred i)) + fromEnum GHC.Types.[] = 0 + fromEnum (False GHC.Types.: as) = (2 * (fromEnum as)) + fromEnum (True GHC.Types.: as) = (1 + (2 * (fromEnum as))) + type family Succ_0123456789 (a :: [Bool]) :: [Bool] where + Succ_0123456789 '[] = Apply (Apply (:$) TrueSym0) '[] + Succ_0123456789 ((:) False as) = Apply (Apply (:$) TrueSym0) as + Succ_0123456789 ((:) True as) = Apply (Apply (:$) FalseSym0) (Apply SuccSym0 as) + type Succ_0123456789Sym1 (t :: [Bool]) = Succ_0123456789 t + instance SuppressUnusedWarnings Succ_0123456789Sym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Succ_0123456789Sym0KindInference GHC.Tuple.()) + data Succ_0123456789Sym0 (l :: TyFun [Bool] [Bool]) + = forall arg. KindOf (Apply Succ_0123456789Sym0 arg) ~ KindOf (Succ_0123456789Sym1 arg) => + Succ_0123456789Sym0KindInference + type instance Apply Succ_0123456789Sym0 l = Succ_0123456789Sym1 l + type family Pred_0123456789 (a :: [Bool]) :: [Bool] where + Pred_0123456789 '[] = Apply ErrorSym0 "pred 0" + Pred_0123456789 ((:) False as) = Apply (Apply (:$) TrueSym0) (Apply PredSym0 as) + Pred_0123456789 ((:) True as) = Apply (Apply (:$) FalseSym0) as + type Pred_0123456789Sym1 (t :: [Bool]) = Pred_0123456789 t + instance SuppressUnusedWarnings Pred_0123456789Sym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Pred_0123456789Sym0KindInference GHC.Tuple.()) + data Pred_0123456789Sym0 (l :: TyFun [Bool] [Bool]) + = forall arg. KindOf (Apply Pred_0123456789Sym0 arg) ~ KindOf (Pred_0123456789Sym1 arg) => + Pred_0123456789Sym0KindInference + type instance Apply Pred_0123456789Sym0 l = Pred_0123456789Sym1 l + type family Case_0123456789 i arg_0123456789 t where + Case_0123456789 i arg_0123456789 True = '[] + Case_0123456789 i arg_0123456789 False = Apply SuccSym0 (Apply ToEnumSym0 (Apply PredSym0 i)) + type family Case_0123456789 i arg_0123456789 t where + Case_0123456789 i arg_0123456789 True = Apply ErrorSym0 "negative toEnum" + Case_0123456789 i arg_0123456789 False = Case_0123456789 i arg_0123456789 (Apply (Apply (:==$) i) (FromInteger 0)) + type family Case_0123456789 arg_0123456789 t where + Case_0123456789 arg_0123456789 i = Case_0123456789 i arg_0123456789 (Apply (Apply (:<$) i) (FromInteger 0)) + type family ToEnum_0123456789 (a :: GHC.Types.Nat) :: [Bool] where + ToEnum_0123456789 arg_0123456789 = Case_0123456789 arg_0123456789 arg_0123456789 + type ToEnum_0123456789Sym1 (t :: GHC.Types.Nat) = + ToEnum_0123456789 t + instance SuppressUnusedWarnings ToEnum_0123456789Sym0 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) ToEnum_0123456789Sym0KindInference GHC.Tuple.()) + data ToEnum_0123456789Sym0 (l :: TyFun GHC.Types.Nat [Bool]) + = forall arg. KindOf (Apply ToEnum_0123456789Sym0 arg) ~ KindOf (ToEnum_0123456789Sym1 arg) => + ToEnum_0123456789Sym0KindInference + type instance Apply ToEnum_0123456789Sym0 l = ToEnum_0123456789Sym1 l + type family FromEnum_0123456789 (a :: [Bool]) :: GHC.Types.Nat where + FromEnum_0123456789 '[] = FromInteger 0 + FromEnum_0123456789 ((:) False as) = Apply (Apply (:*$) (FromInteger 2)) (Apply FromEnumSym0 as) + FromEnum_0123456789 ((:) True as) = Apply (Apply (:+$) (FromInteger 1)) (Apply (Apply (:*$) (FromInteger 2)) (Apply FromEnumSym0 as)) + type FromEnum_0123456789Sym1 (t :: [Bool]) = FromEnum_0123456789 t + instance SuppressUnusedWarnings FromEnum_0123456789Sym0 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) FromEnum_0123456789Sym0KindInference GHC.Tuple.()) + data FromEnum_0123456789Sym0 (l :: TyFun [Bool] GHC.Types.Nat) + = forall arg. KindOf (Apply FromEnum_0123456789Sym0 arg) ~ KindOf (FromEnum_0123456789Sym1 arg) => + FromEnum_0123456789Sym0KindInference + type instance Apply FromEnum_0123456789Sym0 l = FromEnum_0123456789Sym1 l + instance PEnum (KProxy :: KProxy [Bool]) where + type Succ (a :: [Bool]) = Apply Succ_0123456789Sym0 a + type Pred (a :: [Bool]) = Apply Pred_0123456789Sym0 a + type ToEnum (a :: GHC.Types.Nat) = Apply ToEnum_0123456789Sym0 a + type FromEnum (a :: [Bool]) = Apply FromEnum_0123456789Sym0 a + instance SEnum (KProxy :: KProxy [Bool]) where + sSucc :: + forall (t0 :: [Bool]). + Sing t0 + -> Sing (Apply (SuccSym0 :: TyFun [Bool] [Bool] + -> GHC.Types.Type) t0 :: [Bool]) + sPred :: + forall (t0 :: [Bool]). + Sing t0 + -> Sing (Apply (PredSym0 :: TyFun [Bool] [Bool] + -> GHC.Types.Type) t0 :: [Bool]) + sToEnum :: + forall (t0 :: GHC.Types.Nat). + Sing t0 + -> Sing (Apply (ToEnumSym0 :: TyFun GHC.Types.Nat [Bool] + -> GHC.Types.Type) t0 :: [Bool]) + sFromEnum :: + forall (t0 :: [Bool]). + Sing t0 + -> Sing (Apply (FromEnumSym0 :: TyFun [Bool] GHC.Types.Nat + -> GHC.Types.Type) t0 :: GHC.Types.Nat) + sSucc SNil + = let + lambda :: t0 ~ '[] => Sing (Apply SuccSym0 t0 :: [Bool]) + lambda + = applySing + (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) STrue) SNil + in lambda + sSucc (SCons SFalse sAs) + = let + lambda :: + forall as. + t0 ~ Apply (Apply (:$) FalseSym0) as => + Sing as -> Sing (Apply SuccSym0 t0 :: [Bool]) + lambda as + = applySing + (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) STrue) as + in lambda sAs + sSucc (SCons STrue sAs) + = let + lambda :: + forall as. + t0 ~ Apply (Apply (:$) TrueSym0) as => + Sing as -> Sing (Apply SuccSym0 t0 :: [Bool]) + lambda as + = applySing + (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SFalse) + (applySing (singFun1 (Proxy :: Proxy SuccSym0) sSucc) as) + in lambda sAs + sPred SNil + = let + lambda :: t0 ~ '[] => Sing (Apply PredSym0 t0 :: [Bool]) + lambda = sError (sing :: Sing "pred 0") + in lambda + sPred (SCons SFalse sAs) + = let + lambda :: + forall as. + t0 ~ Apply (Apply (:$) FalseSym0) as => + Sing as -> Sing (Apply PredSym0 t0 :: [Bool]) + lambda as + = applySing + (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) STrue) + (applySing (singFun1 (Proxy :: Proxy PredSym0) sPred) as) + in lambda sAs + sPred (SCons STrue sAs) + = let + lambda :: + forall as. + t0 ~ Apply (Apply (:$) TrueSym0) as => + Sing as -> Sing (Apply PredSym0 t0 :: [Bool]) + lambda as + = applySing + (applySing (singFun2 (Proxy :: Proxy (:$)) SCons) SFalse) as + in lambda sAs + sToEnum sArg_0123456789 + = let + lambda :: + forall arg_0123456789. + t0 ~ arg_0123456789 => + Sing arg_0123456789 -> Sing (Apply ToEnumSym0 t0 :: [Bool]) + lambda arg_0123456789 + = case arg_0123456789 of { + sI + -> let + lambda :: + forall i. + i ~ arg_0123456789 => + Sing i -> Sing (Case_0123456789 arg_0123456789 i :: [Bool]) + lambda i + = case + applySing + (applySing (singFun2 (Proxy :: Proxy (:<$)) (%:<)) i) + (sFromInteger (sing :: Sing 0)) + of { + STrue + -> let + lambda :: + TrueSym0 ~ Apply (Apply (:<$) i) (FromInteger 0) => + Sing (Case_0123456789 i arg_0123456789 TrueSym0 :: [Bool]) + lambda = sError (sing :: Sing "negative toEnum") + in lambda + SFalse + -> let + lambda :: + FalseSym0 ~ Apply (Apply (:<$) i) (FromInteger 0) => + Sing (Case_0123456789 i arg_0123456789 FalseSym0 :: [Bool]) + lambda + = case + applySing + (applySing + (singFun2 (Proxy :: Proxy (:==$)) (%:==)) i) + (sFromInteger (sing :: Sing 0)) + of { + STrue + -> let + lambda :: + TrueSym0 ~ Apply (Apply (:==$) i) (FromInteger 0) => + Sing (Case_0123456789 i arg_0123456789 TrueSym0 :: [Bool]) + lambda = SNil + in lambda + SFalse + -> let + lambda :: + FalseSym0 ~ Apply (Apply (:==$) i) (FromInteger 0) => + Sing (Case_0123456789 i arg_0123456789 FalseSym0 :: [Bool]) + lambda + = applySing + (singFun1 (Proxy :: Proxy SuccSym0) sSucc) + (applySing + (singFun1 + (Proxy :: Proxy ToEnumSym0) sToEnum) + (applySing + (singFun1 + (Proxy :: Proxy PredSym0) sPred) + i)) + in lambda } :: + Sing (Case_0123456789 i arg_0123456789 (Apply (Apply (:==$) i) (FromInteger 0)) :: [Bool]) + in lambda } :: + Sing (Case_0123456789 i arg_0123456789 (Apply (Apply (:<$) i) (FromInteger 0)) :: [Bool]) + in lambda sI } :: + Sing (Case_0123456789 arg_0123456789 arg_0123456789 :: [Bool]) + in lambda sArg_0123456789 + sFromEnum SNil + = let + lambda :: t0 ~ '[] => Sing (Apply FromEnumSym0 t0 :: GHC.Types.Nat) + lambda = sFromInteger (sing :: Sing 0) + in lambda + sFromEnum (SCons SFalse sAs) + = let + lambda :: + forall as. + t0 ~ Apply (Apply (:$) FalseSym0) as => + Sing as -> Sing (Apply FromEnumSym0 t0 :: GHC.Types.Nat) + lambda as + = applySing + (applySing + (singFun2 (Proxy :: Proxy (:*$)) (%:*)) + (sFromInteger (sing :: Sing 2))) + (applySing (singFun1 (Proxy :: Proxy FromEnumSym0) sFromEnum) as) + in lambda sAs + sFromEnum (SCons STrue sAs) + = let + lambda :: + forall as. + t0 ~ Apply (Apply (:$) TrueSym0) as => + Sing as -> Sing (Apply FromEnumSym0 t0 :: GHC.Types.Nat) + lambda as + = applySing + (applySing + (singFun2 (Proxy :: Proxy (:+$)) (%:+)) + (sFromInteger (sing :: Sing 1))) + (applySing + (applySing + (singFun2 (Proxy :: Proxy (:*$)) (%:*)) + (sFromInteger (sing :: Sing 2))) + (applySing (singFun1 (Proxy :: Proxy FromEnumSym0) sFromEnum) as)) + in lambda sAs diff --git a/tests/compile-and-dump/Singletons/T136.hs b/tests/compile-and-dump/Singletons/T136.hs new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T136.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE GADTs, DataKinds, PolyKinds, TypeFamilies, KindSignatures #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} +{-# LANGUAGE InstanceSigs, DefaultSignatures #-} + +module Binary where + +import Data.Singletons.TH +import Data.Singletons.Prelude +import Data.Singletons.Prelude.Enum +import Data.Singletons.Prelude.Num + +type Bit = Bool +type BiNat = [Bit] + +$(singletons [d| + instance Enum BiNat where + succ [] = [True] + succ (False:as) = True : as + succ (True:as) = False : succ as + + pred [] = error "pred 0" + pred (False:as) = True : pred as + pred (True:as) = False : as + + toEnum i | i < 0 = error "negative toEnum" + | i == 0 = [] + | otherwise = succ (toEnum (pred i)) + + fromEnum [] = 0 + fromEnum (False:as) = 2 * fromEnum as + fromEnum (True:as) = 1 + 2 * fromEnum as + |]) diff --git a/tests/compile-and-dump/Singletons/T136b.ghc710.template b/tests/compile-and-dump/Singletons/T136b.ghc710.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T136b.ghc710.template @@ -0,0 +1,50 @@ +Singletons/T136b.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| class C a where + meth :: a -> a |] + ======> + class C a where + meth :: a -> a + type MethSym1 (t :: a0123456789) = Meth t + instance SuppressUnusedWarnings MethSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) MethSym0KindInference GHC.Tuple.()) + data MethSym0 (l :: TyFun a0123456789 a0123456789) + = forall arg. KindOf (Apply MethSym0 arg) ~ KindOf (MethSym1 arg) => + MethSym0KindInference + type instance Apply MethSym0 l = MethSym1 l + class kproxy ~ KProxy => PC (kproxy :: KProxy a) where + type family Meth (arg :: a) :: a + class kproxy ~ KProxy => SC (kproxy :: KProxy a) where + sMeth :: forall (t :: a). Sing t -> Sing (Apply MethSym0 t :: a) +Singletons/T136b.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| instance C Bool where + meth = not |] + ======> + instance C Bool where + meth = not + type family Meth_0123456789 (a :: Bool) :: Bool where + Meth_0123456789 a_0123456789 = Apply NotSym0 a_0123456789 + type Meth_0123456789Sym1 (t :: Bool) = Meth_0123456789 t + instance SuppressUnusedWarnings Meth_0123456789Sym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Meth_0123456789Sym0KindInference GHC.Tuple.()) + data Meth_0123456789Sym0 (l :: TyFun Bool Bool) + = forall arg. KindOf (Apply Meth_0123456789Sym0 arg) ~ KindOf (Meth_0123456789Sym1 arg) => + Meth_0123456789Sym0KindInference + type instance Apply Meth_0123456789Sym0 l = Meth_0123456789Sym1 l + instance PC (KProxy :: KProxy Bool) where + type Meth (a :: Bool) = Apply Meth_0123456789Sym0 a + instance SC (KProxy :: KProxy Bool) where + sMeth :: + forall (t :: Bool). + Sing t -> Sing (Apply (MethSym0 :: TyFun Bool Bool -> *) t :: Bool) + sMeth sA_0123456789 + = let + lambda :: + forall a_0123456789. t ~ a_0123456789 => + Sing a_0123456789 -> Sing (Apply MethSym0 t :: Bool) + lambda a_0123456789 + = applySing (singFun1 (Proxy :: Proxy NotSym0) sNot) a_0123456789 + in lambda sA_0123456789 diff --git a/tests/compile-and-dump/Singletons/T136b.ghc80.template b/tests/compile-and-dump/Singletons/T136b.ghc80.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T136b.ghc80.template @@ -0,0 +1,53 @@ +Singletons/T136b.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| class C a where + meth :: a -> a |] + ======> + class C a where + meth :: a -> a + type MethSym1 (t :: a0123456789) = Meth t + instance SuppressUnusedWarnings MethSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) MethSym0KindInference GHC.Tuple.()) + data MethSym0 (l :: TyFun a0123456789 a0123456789) + = forall arg. KindOf (Apply MethSym0 arg) ~ KindOf (MethSym1 arg) => + MethSym0KindInference + type instance Apply MethSym0 l = MethSym1 l + class kproxy ~ KProxy => PC (kproxy :: KProxy a) where + type Meth (arg :: a) :: a + class kproxy ~ KProxy => SC (kproxy :: KProxy a) where + sMeth :: forall (t :: a). Sing t -> Sing (Apply MethSym0 t :: a) +Singletons/T136b.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| instance C Bool where + meth = not |] + ======> + instance C Bool where + meth = not + type family Meth_0123456789 (a :: Bool) :: Bool where + Meth_0123456789 a_0123456789 = Apply NotSym0 a_0123456789 + type Meth_0123456789Sym1 (t :: Bool) = Meth_0123456789 t + instance SuppressUnusedWarnings Meth_0123456789Sym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) Meth_0123456789Sym0KindInference GHC.Tuple.()) + data Meth_0123456789Sym0 (l :: TyFun Bool Bool) + = forall arg. KindOf (Apply Meth_0123456789Sym0 arg) ~ KindOf (Meth_0123456789Sym1 arg) => + Meth_0123456789Sym0KindInference + type instance Apply Meth_0123456789Sym0 l = Meth_0123456789Sym1 l + instance PC (KProxy :: KProxy Bool) where + type Meth (a :: Bool) = Apply Meth_0123456789Sym0 a + instance SC (KProxy :: KProxy Bool) where + sMeth :: + forall (t :: Bool). + Sing t + -> Sing (Apply (MethSym0 :: TyFun Bool Bool + -> GHC.Types.Type) t :: Bool) + sMeth sA_0123456789 + = let + lambda :: + forall a_0123456789. + t ~ a_0123456789 => + Sing a_0123456789 -> Sing (Apply MethSym0 t :: Bool) + lambda a_0123456789 + = applySing (singFun1 (Proxy :: Proxy NotSym0) sNot) a_0123456789 + in lambda sA_0123456789 diff --git a/tests/compile-and-dump/Singletons/T136b.hs b/tests/compile-and-dump/Singletons/T136b.hs new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T136b.hs @@ -0,0 +1,14 @@ +module T136b where + +import Data.Singletons.TH +import Data.Singletons.Prelude.Bool + +$(singletons [d| + class C a where + meth :: a -> a + |]) + +$(singletons [d| + instance C Bool where + meth = not + |]) diff --git a/tests/compile-and-dump/Singletons/T29.ghc710.template b/tests/compile-and-dump/Singletons/T29.ghc710.template --- a/tests/compile-and-dump/Singletons/T29.ghc710.template +++ b/tests/compile-and-dump/Singletons/T29.ghc710.template @@ -68,7 +68,7 @@ sBan sX = let lambda :: - forall x. t ~ x => Sing x -> Sing (Apply BanSym0 x :: Bool) + forall x. t ~ x => Sing x -> Sing (Apply BanSym0 t :: Bool) lambda x = applySing (applySing @@ -87,7 +87,7 @@ sBaz sX = let lambda :: - forall x. t ~ x => Sing x -> Sing (Apply BazSym0 x :: Bool) + forall x. t ~ x => Sing x -> Sing (Apply BazSym0 t :: Bool) lambda x = applySing (applySing @@ -98,7 +98,7 @@ sBar sX = let lambda :: - forall x. t ~ x => Sing x -> Sing (Apply BarSym0 x :: Bool) + forall x. t ~ x => Sing x -> Sing (Apply BarSym0 t :: Bool) lambda x = applySing (applySing @@ -117,7 +117,7 @@ sFoo sX = let lambda :: - forall x. t ~ x => Sing x -> Sing (Apply FooSym0 x :: Bool) + forall x. t ~ x => Sing x -> Sing (Apply FooSym0 t :: Bool) lambda x = applySing (applySing diff --git a/tests/compile-and-dump/Singletons/T29.ghc80.template b/tests/compile-and-dump/Singletons/T29.ghc80.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T29.ghc80.template @@ -0,0 +1,127 @@ +Singletons/T29.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| foo :: Bool -> Bool + foo x = not $ x + bar :: Bool -> Bool + bar x = not . not . not $ x + baz :: Bool -> Bool + baz x = not $! x + ban :: Bool -> Bool + ban x = not . not . not $! x |] + ======> + foo :: Bool -> Bool + foo x = (not $ x) + bar :: Bool -> Bool + bar x = ((not . (not . not)) $ x) + baz :: Bool -> Bool + baz x = (not $! x) + ban :: Bool -> Bool + ban x = ((not . (not . not)) $! x) + type BanSym1 (t :: Bool) = Ban t + instance SuppressUnusedWarnings BanSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) BanSym0KindInference GHC.Tuple.()) + data BanSym0 (l :: TyFun Bool Bool) + = forall arg. KindOf (Apply BanSym0 arg) ~ KindOf (BanSym1 arg) => + BanSym0KindInference + type instance Apply BanSym0 l = BanSym1 l + type BazSym1 (t :: Bool) = Baz t + instance SuppressUnusedWarnings BazSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) BazSym0KindInference GHC.Tuple.()) + data BazSym0 (l :: TyFun Bool Bool) + = forall arg. KindOf (Apply BazSym0 arg) ~ KindOf (BazSym1 arg) => + BazSym0KindInference + type instance Apply BazSym0 l = BazSym1 l + type BarSym1 (t :: Bool) = Bar t + instance SuppressUnusedWarnings BarSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) BarSym0KindInference GHC.Tuple.()) + data BarSym0 (l :: TyFun Bool Bool) + = forall arg. KindOf (Apply BarSym0 arg) ~ KindOf (BarSym1 arg) => + BarSym0KindInference + type instance Apply BarSym0 l = BarSym1 l + type FooSym1 (t :: Bool) = Foo t + instance SuppressUnusedWarnings FooSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) FooSym0KindInference GHC.Tuple.()) + data FooSym0 (l :: TyFun Bool Bool) + = forall arg. KindOf (Apply FooSym0 arg) ~ KindOf (FooSym1 arg) => + FooSym0KindInference + type instance Apply FooSym0 l = FooSym1 l + type family Ban (a :: Bool) :: Bool where + Ban x = Apply (Apply ($!$) (Apply (Apply (:.$) NotSym0) (Apply (Apply (:.$) NotSym0) NotSym0))) x + type family Baz (a :: Bool) :: Bool where + Baz x = Apply (Apply ($!$) NotSym0) x + type family Bar (a :: Bool) :: Bool where + Bar x = Apply (Apply ($$) (Apply (Apply (:.$) NotSym0) (Apply (Apply (:.$) NotSym0) NotSym0))) x + type family Foo (a :: Bool) :: Bool where + Foo x = Apply (Apply ($$) NotSym0) x + sBan :: + forall (t :: Bool). Sing t -> Sing (Apply BanSym0 t :: Bool) + sBaz :: + forall (t :: Bool). Sing t -> Sing (Apply BazSym0 t :: Bool) + sBar :: + forall (t :: Bool). Sing t -> Sing (Apply BarSym0 t :: Bool) + sFoo :: + forall (t :: Bool). Sing t -> Sing (Apply FooSym0 t :: Bool) + sBan sX + = let + lambda :: + forall x. t ~ x => Sing x -> Sing (Apply BanSym0 t :: Bool) + lambda x + = applySing + (applySing + (singFun2 (Proxy :: Proxy ($!$)) (%$!)) + (applySing + (applySing + (singFun3 (Proxy :: Proxy (:.$)) (%:.)) + (singFun1 (Proxy :: Proxy NotSym0) sNot)) + (applySing + (applySing + (singFun3 (Proxy :: Proxy (:.$)) (%:.)) + (singFun1 (Proxy :: Proxy NotSym0) sNot)) + (singFun1 (Proxy :: Proxy NotSym0) sNot)))) + x + in lambda sX + sBaz sX + = let + lambda :: + forall x. t ~ x => Sing x -> Sing (Apply BazSym0 t :: Bool) + lambda x + = applySing + (applySing + (singFun2 (Proxy :: Proxy ($!$)) (%$!)) + (singFun1 (Proxy :: Proxy NotSym0) sNot)) + x + in lambda sX + sBar sX + = let + lambda :: + forall x. t ~ x => Sing x -> Sing (Apply BarSym0 t :: Bool) + lambda x + = applySing + (applySing + (singFun2 (Proxy :: Proxy ($$)) (%$)) + (applySing + (applySing + (singFun3 (Proxy :: Proxy (:.$)) (%:.)) + (singFun1 (Proxy :: Proxy NotSym0) sNot)) + (applySing + (applySing + (singFun3 (Proxy :: Proxy (:.$)) (%:.)) + (singFun1 (Proxy :: Proxy NotSym0) sNot)) + (singFun1 (Proxy :: Proxy NotSym0) sNot)))) + x + in lambda sX + sFoo sX + = let + lambda :: + forall x. t ~ x => Sing x -> Sing (Apply FooSym0 t :: Bool) + lambda x + = applySing + (applySing + (singFun2 (Proxy :: Proxy ($$)) (%$)) + (singFun1 (Proxy :: Proxy NotSym0) sNot)) + x + in lambda sX diff --git a/tests/compile-and-dump/Singletons/T33.ghc710.template b/tests/compile-and-dump/Singletons/T33.ghc710.template --- a/tests/compile-and-dump/Singletons/T33.ghc710.template +++ b/tests/compile-and-dump/Singletons/T33.ghc710.template @@ -23,8 +23,7 @@ forall _z_0123456789 _z_0123456789. t ~ Apply (Apply Tuple2Sym0 _z_0123456789) _z_0123456789 => Sing _z_0123456789 - -> Sing _z_0123456789 - -> Sing (Apply FooSym0 (Apply (Apply Tuple2Sym0 _z_0123456789) _z_0123456789) :: ()) + -> Sing _z_0123456789 -> Sing (Apply FooSym0 t :: ()) lambda _z_0123456789 _z_0123456789 = STuple0 in lambda _s_z_0123456789 _s_z_0123456789 diff --git a/tests/compile-and-dump/Singletons/T33.ghc80.template b/tests/compile-and-dump/Singletons/T33.ghc80.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T33.ghc80.template @@ -0,0 +1,34 @@ +Singletons/T33.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| foo :: (Bool, Bool) -> () + foo ~(_, _) = () |] + ======> + foo :: (Bool, Bool) -> () + foo ~(_, _) = GHC.Tuple.() + type FooSym1 (t :: (Bool, Bool)) = Foo t + instance SuppressUnusedWarnings FooSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) FooSym0KindInference GHC.Tuple.()) + data FooSym0 (l :: TyFun (Bool, Bool) ()) + = forall arg. KindOf (Apply FooSym0 arg) ~ KindOf (FooSym1 arg) => + FooSym0KindInference + type instance Apply FooSym0 l = FooSym1 l + type family Foo (a :: (Bool, Bool)) :: () where + Foo '(_z_0123456789, _z_0123456789) = Tuple0Sym0 + sFoo :: + forall (t :: (Bool, Bool)). Sing t -> Sing (Apply FooSym0 t :: ()) + sFoo (STuple2 _s_z_0123456789 _s_z_0123456789) + = let + lambda :: + forall _z_0123456789 _z_0123456789. + t ~ Apply (Apply Tuple2Sym0 _z_0123456789) _z_0123456789 => + Sing _z_0123456789 + -> Sing _z_0123456789 -> Sing (Apply FooSym0 t :: ()) + lambda _z_0123456789 _z_0123456789 = STuple0 + in lambda _s_z_0123456789 _s_z_0123456789 + +Singletons/T33.hs:0:0: warning: + Lazy pattern converted into regular pattern in promotion + +Singletons/T33.hs:0:0: warning: + Lazy pattern converted into regular pattern during singleton generation. diff --git a/tests/compile-and-dump/Singletons/T54.ghc710.template b/tests/compile-and-dump/Singletons/T54.ghc710.template --- a/tests/compile-and-dump/Singletons/T54.ghc710.template +++ b/tests/compile-and-dump/Singletons/T54.ghc710.template @@ -33,7 +33,7 @@ sG :: forall (t :: Bool). Sing t -> Sing (Apply GSym0 t :: Bool) sG sE = let - lambda :: forall e. t ~ e => Sing e -> Sing (Apply GSym0 e :: Bool) + lambda :: forall e. t ~ e => Sing e -> Sing (Apply GSym0 t :: Bool) lambda e = applySing (let diff --git a/tests/compile-and-dump/Singletons/T54.ghc80.template b/tests/compile-and-dump/Singletons/T54.ghc80.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T54.ghc80.template @@ -0,0 +1,60 @@ +Singletons/T54.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| g :: Bool -> Bool + g e = (case [not] of { [_] -> not }) e |] + ======> + g :: Bool -> Bool + g e = case [not] of { [_] -> not } e + type Let0123456789Scrutinee_0123456789Sym1 t = + Let0123456789Scrutinee_0123456789 t + instance SuppressUnusedWarnings Let0123456789Scrutinee_0123456789Sym0 where + suppressUnusedWarnings _ + = snd + (GHC.Tuple.(,) + Let0123456789Scrutinee_0123456789Sym0KindInference GHC.Tuple.()) + data Let0123456789Scrutinee_0123456789Sym0 l + = forall arg. KindOf (Apply Let0123456789Scrutinee_0123456789Sym0 arg) ~ KindOf (Let0123456789Scrutinee_0123456789Sym1 arg) => + Let0123456789Scrutinee_0123456789Sym0KindInference + type instance Apply Let0123456789Scrutinee_0123456789Sym0 l = Let0123456789Scrutinee_0123456789Sym1 l + type family Let0123456789Scrutinee_0123456789 e where + Let0123456789Scrutinee_0123456789 e = Apply (Apply (:$) NotSym0) '[] + type family Case_0123456789 e t where + Case_0123456789 e '[_z_0123456789] = NotSym0 + type GSym1 (t :: Bool) = G t + instance SuppressUnusedWarnings GSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) GSym0KindInference GHC.Tuple.()) + data GSym0 (l :: TyFun Bool Bool) + = forall arg. KindOf (Apply GSym0 arg) ~ KindOf (GSym1 arg) => + GSym0KindInference + type instance Apply GSym0 l = GSym1 l + type family G (a :: Bool) :: Bool where + G e = Apply (Case_0123456789 e (Let0123456789Scrutinee_0123456789Sym1 e)) e + sG :: forall (t :: Bool). Sing t -> Sing (Apply GSym0 t :: Bool) + sG sE + = let + lambda :: forall e. t ~ e => Sing e -> Sing (Apply GSym0 t :: Bool) + lambda e + = applySing + (let + sScrutinee_0123456789 :: + Sing (Let0123456789Scrutinee_0123456789Sym1 e) + sScrutinee_0123456789 + = applySing + (applySing + (singFun2 (Proxy :: Proxy (:$)) SCons) + (singFun1 (Proxy :: Proxy NotSym0) sNot)) + SNil + in case sScrutinee_0123456789 of { + SCons _s_z_0123456789 SNil + -> let + lambda :: + forall _z_0123456789. + Apply (Apply (:$) _z_0123456789) '[] ~ Let0123456789Scrutinee_0123456789Sym1 e => + Sing _z_0123456789 + -> Sing (Case_0123456789 e (Apply (Apply (:$) _z_0123456789) '[])) + lambda _z_0123456789 = singFun1 (Proxy :: Proxy NotSym0) sNot + in lambda _s_z_0123456789 } :: + Sing (Case_0123456789 e (Let0123456789Scrutinee_0123456789Sym1 e))) + e + in lambda sE diff --git a/tests/compile-and-dump/Singletons/T78.ghc710.template b/tests/compile-and-dump/Singletons/T78.ghc710.template --- a/tests/compile-and-dump/Singletons/T78.ghc710.template +++ b/tests/compile-and-dump/Singletons/T78.ghc710.template @@ -26,20 +26,17 @@ sFoo (SJust SFalse) = let lambda :: - t ~ Apply JustSym0 FalseSym0 => - Sing (Apply FooSym0 (Apply JustSym0 FalseSym0) :: Bool) + t ~ Apply JustSym0 FalseSym0 => Sing (Apply FooSym0 t :: Bool) lambda = SFalse in lambda sFoo (SJust STrue) = let lambda :: - t ~ Apply JustSym0 TrueSym0 => - Sing (Apply FooSym0 (Apply JustSym0 TrueSym0) :: Bool) + t ~ Apply JustSym0 TrueSym0 => Sing (Apply FooSym0 t :: Bool) lambda = STrue in lambda sFoo SNothing = let - lambda :: - t ~ NothingSym0 => Sing (Apply FooSym0 NothingSym0 :: Bool) + lambda :: t ~ NothingSym0 => Sing (Apply FooSym0 t :: Bool) lambda = SFalse in lambda diff --git a/tests/compile-and-dump/Singletons/T78.ghc80.template b/tests/compile-and-dump/Singletons/T78.ghc80.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/T78.ghc80.template @@ -0,0 +1,42 @@ +Singletons/T78.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| foo :: MaybeBool -> Bool + foo (Just False) = False + foo (Just True) = True + foo Nothing = False |] + ======> + foo :: MaybeBool -> Bool + foo (Just False) = False + foo (Just True) = True + foo Nothing = False + type FooSym1 (t :: Maybe Bool) = Foo t + instance SuppressUnusedWarnings FooSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) FooSym0KindInference GHC.Tuple.()) + data FooSym0 (l :: TyFun (Maybe Bool) Bool) + = forall arg. KindOf (Apply FooSym0 arg) ~ KindOf (FooSym1 arg) => + FooSym0KindInference + type instance Apply FooSym0 l = FooSym1 l + type family Foo (a :: Maybe Bool) :: Bool where + Foo (Just False) = FalseSym0 + Foo (Just True) = TrueSym0 + Foo Nothing = FalseSym0 + sFoo :: + forall (t :: Maybe Bool). Sing t -> Sing (Apply FooSym0 t :: Bool) + sFoo (SJust SFalse) + = let + lambda :: + t ~ Apply JustSym0 FalseSym0 => Sing (Apply FooSym0 t :: Bool) + lambda = SFalse + in lambda + sFoo (SJust STrue) + = let + lambda :: + t ~ Apply JustSym0 TrueSym0 => Sing (Apply FooSym0 t :: Bool) + lambda = STrue + in lambda + sFoo SNothing + = let + lambda :: t ~ NothingSym0 => Sing (Apply FooSym0 t :: Bool) + lambda = SFalse + in lambda diff --git a/tests/compile-and-dump/Singletons/TopLevelPatterns.ghc710.template b/tests/compile-and-dump/Singletons/TopLevelPatterns.ghc710.template --- a/tests/compile-and-dump/Singletons/TopLevelPatterns.ghc710.template +++ b/tests/compile-and-dump/Singletons/TopLevelPatterns.ghc710.template @@ -120,11 +120,11 @@ = forall arg. KindOf (Apply NotSym0 arg) ~ KindOf (NotSym1 arg) => NotSym0KindInference type instance Apply NotSym0 l = NotSym1 l - type IdSym1 (t :: a) = Id t + type IdSym1 (t :: a0123456789) = Id t instance SuppressUnusedWarnings IdSym0 where suppressUnusedWarnings _ = Data.Tuple.snd (GHC.Tuple.(,) IdSym0KindInference GHC.Tuple.()) - data IdSym0 (l :: TyFun a a) + data IdSym0 (l :: TyFun a0123456789 a0123456789) = forall arg. KindOf (Apply IdSym0 arg) ~ KindOf (IdSym1 arg) => IdSym0KindInference type instance Apply IdSym0 l = IdSym1 l @@ -222,24 +222,24 @@ sFalse_ = SFalse sNot STrue = let - lambda :: t ~ TrueSym0 => Sing (Apply NotSym0 TrueSym0 :: Bool) + lambda :: t ~ TrueSym0 => Sing (Apply NotSym0 t :: Bool) lambda = SFalse in lambda sNot SFalse = let - lambda :: t ~ FalseSym0 => Sing (Apply NotSym0 FalseSym0 :: Bool) + lambda :: t ~ FalseSym0 => Sing (Apply NotSym0 t :: Bool) lambda = STrue in lambda sId sX = let - lambda :: forall x. t ~ x => Sing x -> Sing (Apply IdSym0 x :: a) + lambda :: forall x. t ~ x => Sing x -> Sing (Apply IdSym0 t :: a) lambda x = x in lambda sX sF sA_0123456789 = let lambda :: forall a_0123456789. t ~ a_0123456789 => - Sing a_0123456789 -> Sing (Apply FSym0 a_0123456789 :: Bool) + Sing a_0123456789 -> Sing (Apply FSym0 t :: Bool) lambda a_0123456789 = applySing (case sX_0123456789 of { @@ -260,7 +260,7 @@ = let lambda :: forall a_0123456789. t ~ a_0123456789 => - Sing a_0123456789 -> Sing (Apply GSym0 a_0123456789 :: Bool) + Sing a_0123456789 -> Sing (Apply GSym0 t :: Bool) lambda a_0123456789 = applySing (case sX_0123456789 of { @@ -281,7 +281,7 @@ = let lambda :: forall a_0123456789. t ~ a_0123456789 => - Sing a_0123456789 -> Sing (Apply HSym0 a_0123456789 :: Bool) + Sing a_0123456789 -> Sing (Apply HSym0 t :: Bool) lambda a_0123456789 = applySing (case sX_0123456789 of { @@ -302,7 +302,7 @@ = let lambda :: forall a_0123456789. t ~ a_0123456789 => - Sing a_0123456789 -> Sing (Apply ISym0 a_0123456789 :: Bool) + Sing a_0123456789 -> Sing (Apply ISym0 t :: Bool) lambda a_0123456789 = applySing (case sX_0123456789 of { @@ -328,10 +328,10 @@ _z_0123456789. Apply (Apply BarSym0 y_0123456789) _z_0123456789 ~ X_0123456789Sym0 => Sing y_0123456789 -> Sing _z_0123456789 - -> Sing (Case_0123456789 (Apply (Apply BarSym0 y_0123456789) _z_0123456789)) + -> Sing (Case_0123456789 (Apply (Apply BarSym0 y_0123456789) _z_0123456789) :: Bool) lambda y_0123456789 _z_0123456789 = y_0123456789 in lambda sY_0123456789 _s_z_0123456789 } :: - Sing (Case_0123456789 X_0123456789Sym0) + Sing (Case_0123456789 X_0123456789Sym0 :: Bool) sK = case sX_0123456789 of { SBar _s_z_0123456789 sY_0123456789 @@ -341,10 +341,10 @@ y_0123456789. Apply (Apply BarSym0 _z_0123456789) y_0123456789 ~ X_0123456789Sym0 => Sing _z_0123456789 -> Sing y_0123456789 - -> Sing (Case_0123456789 (Apply (Apply BarSym0 _z_0123456789) y_0123456789)) + -> Sing (Case_0123456789 (Apply (Apply BarSym0 _z_0123456789) y_0123456789) :: Bool) lambda _z_0123456789 y_0123456789 = y_0123456789 in lambda _s_z_0123456789 sY_0123456789 } :: - Sing (Case_0123456789 X_0123456789Sym0) + Sing (Case_0123456789 X_0123456789Sym0 :: Bool) sL = case sX_0123456789 of { SCons sY_0123456789 (SCons _s_z_0123456789 SNil) @@ -354,10 +354,10 @@ _z_0123456789. Apply (Apply (:$) y_0123456789) (Apply (Apply (:$) _z_0123456789) '[]) ~ X_0123456789Sym0 => Sing y_0123456789 -> Sing _z_0123456789 - -> Sing (Case_0123456789 (Apply (Apply (:$) y_0123456789) (Apply (Apply (:$) _z_0123456789) '[]))) + -> Sing (Case_0123456789 (Apply (Apply (:$) y_0123456789) (Apply (Apply (:$) _z_0123456789) '[])) :: Bool) lambda y_0123456789 _z_0123456789 = y_0123456789 in lambda sY_0123456789 _s_z_0123456789 } :: - Sing (Case_0123456789 X_0123456789Sym0) + Sing (Case_0123456789 X_0123456789Sym0 :: Bool) sM = case sX_0123456789 of { SCons _s_z_0123456789 (SCons sY_0123456789 SNil) @@ -367,10 +367,10 @@ y_0123456789. Apply (Apply (:$) _z_0123456789) (Apply (Apply (:$) y_0123456789) '[]) ~ X_0123456789Sym0 => Sing _z_0123456789 -> Sing y_0123456789 - -> Sing (Case_0123456789 (Apply (Apply (:$) _z_0123456789) (Apply (Apply (:$) y_0123456789) '[]))) + -> Sing (Case_0123456789 (Apply (Apply (:$) _z_0123456789) (Apply (Apply (:$) y_0123456789) '[])) :: Bool) lambda _z_0123456789 y_0123456789 = y_0123456789 in lambda _s_z_0123456789 sY_0123456789 } :: - Sing (Case_0123456789 X_0123456789Sym0) + Sing (Case_0123456789 X_0123456789Sym0 :: Bool) sOtherwise = STrue sX_0123456789 = applySing diff --git a/tests/compile-and-dump/Singletons/TopLevelPatterns.ghc80.template b/tests/compile-and-dump/Singletons/TopLevelPatterns.ghc80.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/TopLevelPatterns.ghc80.template @@ -0,0 +1,408 @@ +Singletons/TopLevelPatterns.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| data Bool = False | True + data Foo = Bar Bool Bool |] + ======> + data Bool = False | True + data Foo = Bar Bool Bool + type FalseSym0 = False + type TrueSym0 = True + type BarSym2 (t :: Bool) (t :: Bool) = Bar t t + instance SuppressUnusedWarnings BarSym1 where + suppressUnusedWarnings _ + = Data.Tuple.snd (GHC.Tuple.(,) BarSym1KindInference GHC.Tuple.()) + data BarSym1 (l :: Bool) (l :: TyFun Bool Foo) + = forall arg. KindOf (Apply (BarSym1 l) arg) ~ KindOf (BarSym2 l arg) => + BarSym1KindInference + type instance Apply (BarSym1 l) l = BarSym2 l l + instance SuppressUnusedWarnings BarSym0 where + suppressUnusedWarnings _ + = Data.Tuple.snd (GHC.Tuple.(,) BarSym0KindInference GHC.Tuple.()) + data BarSym0 (l :: TyFun Bool (TyFun Bool Foo -> GHC.Types.Type)) + = forall arg. KindOf (Apply BarSym0 arg) ~ KindOf (BarSym1 arg) => + BarSym0KindInference + type instance Apply BarSym0 l = BarSym1 l + data instance Sing (z :: Bool) + = z ~ False => SFalse | z ~ True => STrue + type SBool = (Sing :: Bool -> GHC.Types.Type) + instance SingKind (KProxy :: KProxy Bool) where + type DemoteRep (KProxy :: KProxy Bool) = Bool + fromSing SFalse = False + fromSing STrue = True + toSing False = SomeSing SFalse + toSing True = SomeSing STrue + data instance Sing (z :: Foo) + = forall (n :: Bool) (n :: Bool). z ~ Bar n n => + SBar (Sing (n :: Bool)) (Sing (n :: Bool)) + type SFoo = (Sing :: Foo -> GHC.Types.Type) + instance SingKind (KProxy :: KProxy Foo) where + type DemoteRep (KProxy :: KProxy Foo) = Foo + fromSing (SBar b b) = Bar (fromSing b) (fromSing b) + toSing (Bar b b) + = case + GHC.Tuple.(,) + (toSing b :: SomeSing (KProxy :: KProxy Bool)) + (toSing b :: SomeSing (KProxy :: KProxy Bool)) + of { + GHC.Tuple.(,) (SomeSing c) (SomeSing c) -> SomeSing (SBar c c) } + instance SingI False where + sing = SFalse + instance SingI True where + sing = STrue + instance (SingI n, SingI n) => + SingI (Bar (n :: Bool) (n :: Bool)) where + sing = SBar sing sing +Singletons/TopLevelPatterns.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| otherwise :: Bool + otherwise = True + id :: a -> a + id x = x + not :: Bool -> Bool + not True = False + not False = True + false_ = False + f, g :: Bool -> Bool + [f, g] = [not, id] + h, i :: Bool -> Bool + (h, i) = (f, g) + j, k :: Bool + (Bar j k) = Bar True (h False) + l, m :: Bool + [l, m] = [not True, id False] |] + ======> + otherwise :: Bool + otherwise = True + id :: forall a. a -> a + id x = x + not :: Bool -> Bool + not True = False + not False = True + false_ = False + f :: Bool -> Bool + g :: Bool -> Bool + [f, g] = [not, id] + h :: Bool -> Bool + i :: Bool -> Bool + (h, i) = (f, g) + j :: Bool + k :: Bool + Bar j k = Bar True (h False) + l :: Bool + m :: Bool + [l, m] = [not True, id False] + type family Case_0123456789 a_0123456789 t where + Case_0123456789 a_0123456789 '[y_0123456789, + _z_0123456789] = y_0123456789 + type family Case_0123456789 a_0123456789 t where + Case_0123456789 a_0123456789 '[_z_0123456789, + y_0123456789] = y_0123456789 + type family Case_0123456789 a_0123456789 t where + Case_0123456789 a_0123456789 '(y_0123456789, + _z_0123456789) = y_0123456789 + type family Case_0123456789 a_0123456789 t where + Case_0123456789 a_0123456789 '(_z_0123456789, + y_0123456789) = y_0123456789 + type family Case_0123456789 t where + Case_0123456789 (Bar y_0123456789 _z_0123456789) = y_0123456789 + type family Case_0123456789 t where + Case_0123456789 (Bar _z_0123456789 y_0123456789) = y_0123456789 + type family Case_0123456789 t where + Case_0123456789 '[y_0123456789, _z_0123456789] = y_0123456789 + type family Case_0123456789 t where + Case_0123456789 '[_z_0123456789, y_0123456789] = y_0123456789 + type False_Sym0 = False_ + type NotSym1 (t :: Bool) = Not t + instance SuppressUnusedWarnings NotSym0 where + suppressUnusedWarnings _ + = Data.Tuple.snd (GHC.Tuple.(,) NotSym0KindInference GHC.Tuple.()) + data NotSym0 (l :: TyFun Bool Bool) + = forall arg. KindOf (Apply NotSym0 arg) ~ KindOf (NotSym1 arg) => + NotSym0KindInference + type instance Apply NotSym0 l = NotSym1 l + type IdSym1 (t :: a0123456789) = Id t + instance SuppressUnusedWarnings IdSym0 where + suppressUnusedWarnings _ + = Data.Tuple.snd (GHC.Tuple.(,) IdSym0KindInference GHC.Tuple.()) + data IdSym0 (l :: TyFun a0123456789 a0123456789) + = forall arg. KindOf (Apply IdSym0 arg) ~ KindOf (IdSym1 arg) => + IdSym0KindInference + type instance Apply IdSym0 l = IdSym1 l + type FSym1 (t :: Bool) = F t + instance SuppressUnusedWarnings FSym0 where + suppressUnusedWarnings _ + = Data.Tuple.snd (GHC.Tuple.(,) FSym0KindInference GHC.Tuple.()) + data FSym0 (l :: TyFun Bool Bool) + = forall arg. KindOf (Apply FSym0 arg) ~ KindOf (FSym1 arg) => + FSym0KindInference + type instance Apply FSym0 l = FSym1 l + type GSym1 (t :: Bool) = G t + instance SuppressUnusedWarnings GSym0 where + suppressUnusedWarnings _ + = Data.Tuple.snd (GHC.Tuple.(,) GSym0KindInference GHC.Tuple.()) + data GSym0 (l :: TyFun Bool Bool) + = forall arg. KindOf (Apply GSym0 arg) ~ KindOf (GSym1 arg) => + GSym0KindInference + type instance Apply GSym0 l = GSym1 l + type HSym1 (t :: Bool) = H t + instance SuppressUnusedWarnings HSym0 where + suppressUnusedWarnings _ + = Data.Tuple.snd (GHC.Tuple.(,) HSym0KindInference GHC.Tuple.()) + data HSym0 (l :: TyFun Bool Bool) + = forall arg. KindOf (Apply HSym0 arg) ~ KindOf (HSym1 arg) => + HSym0KindInference + type instance Apply HSym0 l = HSym1 l + type ISym1 (t :: Bool) = I t + instance SuppressUnusedWarnings ISym0 where + suppressUnusedWarnings _ + = Data.Tuple.snd (GHC.Tuple.(,) ISym0KindInference GHC.Tuple.()) + data ISym0 (l :: TyFun Bool Bool) + = forall arg. KindOf (Apply ISym0 arg) ~ KindOf (ISym1 arg) => + ISym0KindInference + type instance Apply ISym0 l = ISym1 l + type JSym0 = J + type KSym0 = K + type LSym0 = L + type MSym0 = M + type OtherwiseSym0 = Otherwise + type X_0123456789Sym0 = X_0123456789 + type X_0123456789Sym0 = X_0123456789 + type X_0123456789Sym0 = X_0123456789 + type X_0123456789Sym0 = X_0123456789 + type family False_ where + False_ = FalseSym0 + type family Not (a :: Bool) :: Bool where + Not True = FalseSym0 + Not False = TrueSym0 + type family Id (a :: a) :: a where + Id x = x + type family F (a :: Bool) :: Bool where + F a_0123456789 = Apply (Case_0123456789 a_0123456789 X_0123456789Sym0) a_0123456789 + type family G (a :: Bool) :: Bool where + G a_0123456789 = Apply (Case_0123456789 a_0123456789 X_0123456789Sym0) a_0123456789 + type family H (a :: Bool) :: Bool where + H a_0123456789 = Apply (Case_0123456789 a_0123456789 X_0123456789Sym0) a_0123456789 + type family I (a :: Bool) :: Bool where + I a_0123456789 = Apply (Case_0123456789 a_0123456789 X_0123456789Sym0) a_0123456789 + type family J :: Bool where + J = Case_0123456789 X_0123456789Sym0 + type family K :: Bool where + K = Case_0123456789 X_0123456789Sym0 + type family L :: Bool where + L = Case_0123456789 X_0123456789Sym0 + type family M :: Bool where + M = Case_0123456789 X_0123456789Sym0 + type family Otherwise :: Bool where + Otherwise = TrueSym0 + type family X_0123456789 where + X_0123456789 = Apply (Apply (:$) NotSym0) (Apply (Apply (:$) IdSym0) '[]) + type family X_0123456789 where + X_0123456789 = Apply (Apply Tuple2Sym0 FSym0) GSym0 + type family X_0123456789 where + X_0123456789 = Apply (Apply BarSym0 TrueSym0) (Apply HSym0 FalseSym0) + type family X_0123456789 where + X_0123456789 = 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 (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) + sX_0123456789 :: Sing X_0123456789Sym0 + sX_0123456789 :: Sing X_0123456789Sym0 + sX_0123456789 :: Sing X_0123456789Sym0 + sX_0123456789 :: Sing X_0123456789Sym0 + sFalse_ = SFalse + sNot STrue + = let + lambda :: t ~ TrueSym0 => Sing (Apply NotSym0 t :: Bool) + lambda = SFalse + in lambda + sNot SFalse + = let + lambda :: t ~ FalseSym0 => Sing (Apply NotSym0 t :: Bool) + lambda = STrue + in lambda + sId sX + = let + lambda :: forall x. t ~ x => Sing x -> Sing (Apply IdSym0 t :: a) + lambda x = x + in lambda sX + sF sA_0123456789 + = let + lambda :: + forall a_0123456789. + t ~ a_0123456789 => + Sing a_0123456789 -> Sing (Apply FSym0 t :: Bool) + lambda a_0123456789 + = applySing + (case sX_0123456789 of { + SCons sY_0123456789 (SCons _s_z_0123456789 SNil) + -> let + lambda :: + forall y_0123456789 _z_0123456789. + Apply (Apply (:$) y_0123456789) (Apply (Apply (:$) _z_0123456789) '[]) ~ X_0123456789Sym0 => + Sing y_0123456789 + -> Sing _z_0123456789 + -> Sing (Case_0123456789 a_0123456789 (Apply (Apply (:$) y_0123456789) (Apply (Apply (:$) _z_0123456789) '[]))) + lambda y_0123456789 _z_0123456789 = y_0123456789 + in lambda sY_0123456789 _s_z_0123456789 } :: + Sing (Case_0123456789 a_0123456789 X_0123456789Sym0)) + a_0123456789 + in lambda sA_0123456789 + sG sA_0123456789 + = let + lambda :: + forall a_0123456789. + t ~ a_0123456789 => + Sing a_0123456789 -> Sing (Apply GSym0 t :: Bool) + lambda a_0123456789 + = applySing + (case sX_0123456789 of { + SCons _s_z_0123456789 (SCons sY_0123456789 SNil) + -> let + lambda :: + forall _z_0123456789 y_0123456789. + Apply (Apply (:$) _z_0123456789) (Apply (Apply (:$) y_0123456789) '[]) ~ X_0123456789Sym0 => + Sing _z_0123456789 + -> Sing y_0123456789 + -> Sing (Case_0123456789 a_0123456789 (Apply (Apply (:$) _z_0123456789) (Apply (Apply (:$) y_0123456789) '[]))) + lambda _z_0123456789 y_0123456789 = y_0123456789 + in lambda _s_z_0123456789 sY_0123456789 } :: + Sing (Case_0123456789 a_0123456789 X_0123456789Sym0)) + a_0123456789 + in lambda sA_0123456789 + sH sA_0123456789 + = let + lambda :: + forall a_0123456789. + t ~ a_0123456789 => + Sing a_0123456789 -> Sing (Apply HSym0 t :: Bool) + lambda a_0123456789 + = applySing + (case sX_0123456789 of { + STuple2 sY_0123456789 _s_z_0123456789 + -> let + lambda :: + forall y_0123456789 _z_0123456789. + Apply (Apply Tuple2Sym0 y_0123456789) _z_0123456789 ~ X_0123456789Sym0 => + Sing y_0123456789 + -> Sing _z_0123456789 + -> Sing (Case_0123456789 a_0123456789 (Apply (Apply Tuple2Sym0 y_0123456789) _z_0123456789)) + lambda y_0123456789 _z_0123456789 = y_0123456789 + in lambda sY_0123456789 _s_z_0123456789 } :: + Sing (Case_0123456789 a_0123456789 X_0123456789Sym0)) + a_0123456789 + in lambda sA_0123456789 + sI sA_0123456789 + = let + lambda :: + forall a_0123456789. + t ~ a_0123456789 => + Sing a_0123456789 -> Sing (Apply ISym0 t :: Bool) + lambda a_0123456789 + = applySing + (case sX_0123456789 of { + STuple2 _s_z_0123456789 sY_0123456789 + -> let + lambda :: + forall _z_0123456789 y_0123456789. + Apply (Apply Tuple2Sym0 _z_0123456789) y_0123456789 ~ X_0123456789Sym0 => + Sing _z_0123456789 + -> Sing y_0123456789 + -> Sing (Case_0123456789 a_0123456789 (Apply (Apply Tuple2Sym0 _z_0123456789) y_0123456789)) + lambda _z_0123456789 y_0123456789 = y_0123456789 + in lambda _s_z_0123456789 sY_0123456789 } :: + Sing (Case_0123456789 a_0123456789 X_0123456789Sym0)) + a_0123456789 + in lambda sA_0123456789 + sJ + = case sX_0123456789 of { + SBar sY_0123456789 _s_z_0123456789 + -> let + lambda :: + forall y_0123456789 _z_0123456789. + Apply (Apply BarSym0 y_0123456789) _z_0123456789 ~ X_0123456789Sym0 => + Sing y_0123456789 + -> Sing _z_0123456789 + -> Sing (Case_0123456789 (Apply (Apply BarSym0 y_0123456789) _z_0123456789) :: Bool) + lambda y_0123456789 _z_0123456789 = y_0123456789 + in lambda sY_0123456789 _s_z_0123456789 } :: + Sing (Case_0123456789 X_0123456789Sym0 :: Bool) + sK + = case sX_0123456789 of { + SBar _s_z_0123456789 sY_0123456789 + -> let + lambda :: + forall _z_0123456789 y_0123456789. + Apply (Apply BarSym0 _z_0123456789) y_0123456789 ~ X_0123456789Sym0 => + Sing _z_0123456789 + -> Sing y_0123456789 + -> Sing (Case_0123456789 (Apply (Apply BarSym0 _z_0123456789) y_0123456789) :: Bool) + lambda _z_0123456789 y_0123456789 = y_0123456789 + in lambda _s_z_0123456789 sY_0123456789 } :: + Sing (Case_0123456789 X_0123456789Sym0 :: Bool) + sL + = case sX_0123456789 of { + SCons sY_0123456789 (SCons _s_z_0123456789 SNil) + -> let + lambda :: + forall y_0123456789 _z_0123456789. + Apply (Apply (:$) y_0123456789) (Apply (Apply (:$) _z_0123456789) '[]) ~ X_0123456789Sym0 => + Sing y_0123456789 + -> Sing _z_0123456789 + -> Sing (Case_0123456789 (Apply (Apply (:$) y_0123456789) (Apply (Apply (:$) _z_0123456789) '[])) :: Bool) + lambda y_0123456789 _z_0123456789 = y_0123456789 + in lambda sY_0123456789 _s_z_0123456789 } :: + Sing (Case_0123456789 X_0123456789Sym0 :: Bool) + sM + = case sX_0123456789 of { + SCons _s_z_0123456789 (SCons sY_0123456789 SNil) + -> let + lambda :: + forall _z_0123456789 y_0123456789. + Apply (Apply (:$) _z_0123456789) (Apply (Apply (:$) y_0123456789) '[]) ~ X_0123456789Sym0 => + Sing _z_0123456789 + -> Sing y_0123456789 + -> Sing (Case_0123456789 (Apply (Apply (:$) _z_0123456789) (Apply (Apply (:$) y_0123456789) '[])) :: Bool) + lambda _z_0123456789 y_0123456789 = y_0123456789 + in lambda _s_z_0123456789 sY_0123456789 } :: + Sing (Case_0123456789 X_0123456789Sym0 :: Bool) + sOtherwise = STrue + sX_0123456789 + = applySing + (applySing + (singFun2 (Proxy :: Proxy (:$)) SCons) + (singFun1 (Proxy :: Proxy NotSym0) sNot)) + (applySing + (applySing + (singFun2 (Proxy :: Proxy (:$)) SCons) + (singFun1 (Proxy :: Proxy IdSym0) sId)) + SNil) + sX_0123456789 + = applySing + (applySing + (singFun2 (Proxy :: Proxy Tuple2Sym0) STuple2) + (singFun1 (Proxy :: Proxy FSym0) sF)) + (singFun1 (Proxy :: Proxy GSym0) sG) + sX_0123456789 + = applySing + (applySing (singFun2 (Proxy :: Proxy BarSym0) SBar) STrue) + (applySing (singFun1 (Proxy :: Proxy HSym0) sH) SFalse) + sX_0123456789 + = applySing + (applySing + (singFun2 (Proxy :: Proxy (:$)) SCons) + (applySing (singFun1 (Proxy :: Proxy NotSym0) sNot) STrue)) + (applySing + (applySing + (singFun2 (Proxy :: Proxy (:$)) SCons) + (applySing (singFun1 (Proxy :: Proxy IdSym0) sId) SFalse)) + SNil) diff --git a/tests/compile-and-dump/Singletons/Undef.ghc710.template b/tests/compile-and-dump/Singletons/Undef.ghc710.template --- a/tests/compile-and-dump/Singletons/Undef.ghc710.template +++ b/tests/compile-and-dump/Singletons/Undef.ghc710.template @@ -37,13 +37,13 @@ = let lambda :: forall a_0123456789. t ~ a_0123456789 => - Sing a_0123456789 -> Sing (Apply BarSym0 a_0123456789 :: Bool) + Sing a_0123456789 -> Sing (Apply BarSym0 t :: Bool) lambda a_0123456789 = sError (sing :: Sing "urk") in lambda sA_0123456789 sFoo sA_0123456789 = let lambda :: forall a_0123456789. t ~ a_0123456789 => - Sing a_0123456789 -> Sing (Apply FooSym0 a_0123456789 :: Bool) + Sing a_0123456789 -> Sing (Apply FooSym0 t :: Bool) lambda a_0123456789 = undefined in lambda sA_0123456789 diff --git a/tests/compile-and-dump/Singletons/Undef.ghc80.template b/tests/compile-and-dump/Singletons/Undef.ghc80.template new file mode 100644 --- /dev/null +++ b/tests/compile-and-dump/Singletons/Undef.ghc80.template @@ -0,0 +1,51 @@ +Singletons/Undef.hs:(0,0)-(0,0): Splicing declarations + singletons + [d| foo :: Bool -> Bool + foo = undefined + bar :: Bool -> Bool + bar = error "urk" |] + ======> + foo :: Bool -> Bool + foo = undefined + bar :: Bool -> Bool + bar = error "urk" + type BarSym1 (t :: Bool) = Bar t + instance SuppressUnusedWarnings BarSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) BarSym0KindInference GHC.Tuple.()) + data BarSym0 (l :: TyFun Bool Bool) + = forall arg. KindOf (Apply BarSym0 arg) ~ KindOf (BarSym1 arg) => + BarSym0KindInference + type instance Apply BarSym0 l = BarSym1 l + type FooSym1 (t :: Bool) = Foo t + instance SuppressUnusedWarnings FooSym0 where + suppressUnusedWarnings _ + = snd (GHC.Tuple.(,) FooSym0KindInference GHC.Tuple.()) + data FooSym0 (l :: TyFun Bool Bool) + = forall arg. KindOf (Apply FooSym0 arg) ~ KindOf (FooSym1 arg) => + FooSym0KindInference + type instance Apply FooSym0 l = FooSym1 l + type family Bar (a :: Bool) :: Bool where + Bar a_0123456789 = Apply (Apply ErrorSym0 "urk") a_0123456789 + type family Foo (a :: Bool) :: Bool where + Foo a_0123456789 = Apply Any a_0123456789 + sBar :: + forall (t :: Bool). Sing t -> Sing (Apply BarSym0 t :: Bool) + sFoo :: + forall (t :: Bool). Sing t -> Sing (Apply FooSym0 t :: Bool) + sBar sA_0123456789 + = let + lambda :: + forall a_0123456789. + t ~ a_0123456789 => + Sing a_0123456789 -> Sing (Apply BarSym0 t :: Bool) + lambda a_0123456789 = sError (sing :: Sing "urk") + in lambda sA_0123456789 + sFoo sA_0123456789 + = let + lambda :: + forall a_0123456789. + t ~ a_0123456789 => + Sing a_0123456789 -> Sing (Apply FooSym0 t :: Bool) + lambda a_0123456789 = undefined + in lambda sA_0123456789