diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,8 @@ # Changelog for the [`ghc-typelits-extra`](http://hackage.haskell.org/package/ghc-typelits-extra) package +# 0.4.2 *January 1st 2021* +* Add support for GHC 9.0.1-rc1 + # 0.4.1 *November 10 2020* * Reduce `n <=? Max (n + p) p` to `True` diff --git a/ghc-typelits-extra.cabal b/ghc-typelits-extra.cabal --- a/ghc-typelits-extra.cabal +++ b/ghc-typelits-extra.cabal @@ -1,5 +1,5 @@ name: ghc-typelits-extra -version: 0.4.1 +version: 0.4.2 synopsis: Additional type-level operations on GHC.TypeLits.Nat description: Additional type-level operations on @GHC.TypeLits.Nat@: @@ -48,7 +48,7 @@ CHANGELOG.md cabal-version: >=1.10 tested-with: GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5, - GHC == 8.8.1, GHC == 8.10.1 + GHC == 8.8.4, GHC == 8.10.3, GHC == 9.0.1 source-repository head @@ -68,13 +68,16 @@ GHC.TypeLits.Extra.Solver.Operations build-depends: base >= 4.8 && <5, containers >= 0.5.7.1 && <0.7, - ghc >= 7.10 && <8.11, + ghc >= 7.10 && <9.2, ghc-prim >= 0.5 && <1.0, ghc-tcplugins-extra >= 0.3.1, ghc-typelits-knownnat >= 0.7.2 && <0.8, ghc-typelits-natnormalise >= 0.7.1 && <0.8, - integer-gmp >= 1.0 && <1.1, transformers >= 0.4.2.0 && <0.6 + if impl(ghc >= 9.0.0) + build-depends: ghc-bignum >=1.0 && <1.1 + else + build-depends: integer-gmp >=1.0 && <1.1 hs-source-dirs: src default-language: Haskell2010 other-extensions: DataKinds diff --git a/src/GHC/TypeLits/Extra/Solver.hs b/src/GHC/TypeLits/Extra/Solver.hs --- a/src/GHC/TypeLits/Extra/Solver.hs +++ b/src/GHC/TypeLits/Extra/Solver.hs @@ -27,8 +27,31 @@ import Data.Maybe (catMaybes) import GHC.TcPluginM.Extra (evByFiat, lookupModule, lookupName ,tracePlugin, newWanted) +#if MIN_VERSION_ghc(8,4,0) +import GHC.TcPluginM.Extra (flattenGivens) +#else +import Control.Monad ((<=<)) +#endif -- GHC API +#if MIN_VERSION_ghc(9,0,0) +import GHC.Builtin.Names (eqPrimTyConKey, hasKey) +import GHC.Builtin.Types (typeNatKind, promotedTrueDataCon, promotedFalseDataCon) +import GHC.Builtin.Types.Literals (typeNatLeqTyCon, typeNatTyCons) +import GHC.Core.Predicate (EqRel (NomEq), Pred (EqPred), classifyPredType) +import GHC.Core.TyCo.Rep (Type (..)) +import GHC.Core.Type (Kind, eqType, mkTyConApp, splitTyConApp_maybe, typeKind) +import GHC.Data.FastString (fsLit) +import GHC.Driver.Plugins (Plugin (..), defaultPlugin, purePlugin) +import GHC.Tc.Plugin (TcPluginM, tcLookupTyCon, tcPluginTrace) +import GHC.Tc.Types (TcPlugin(..), TcPluginResult (..)) +import GHC.Tc.Types.Constraint + (Ct, ctEvidence, ctEvPred, ctLoc, isWantedCt, cc_ev) +import GHC.Tc.Types.Evidence (EvTerm) +import GHC.Types.Name.Occurrence (mkTcOcc) +import GHC.Unit.Module (mkModuleName) +import GHC.Utils.Outputable (Outputable (..), (<+>), ($$), text) +#else import FastString (fsLit) import Module (mkModuleName) import OccName (mkTcOcc) @@ -46,11 +69,9 @@ import TysWiredIn (typeNatKind, promotedTrueDataCon, promotedFalseDataCon) import TcTypeNats (typeNatLeqTyCon) #if MIN_VERSION_ghc(8,4,0) -import GHC.TcPluginM.Extra (flattenGivens) import TcTypeNats (typeNatTyCons) #else import TcPluginM (zonkCt) -import Control.Monad ((<=<)) #endif #if MIN_VERSION_ghc(8,10,0) @@ -61,6 +82,7 @@ import TcRnTypes (Ct, CtEvidence, ctEvidence, ctEvPred, ctLoc, isWantedCt, cc_ev) import TcType (typeKind) import Type (EqRel (NomEq), PredTree (EqPred), classifyPredType) +#endif #endif -- internal diff --git a/src/GHC/TypeLits/Extra/Solver/Operations.hs b/src/GHC/TypeLits/Extra/Solver/Operations.hs --- a/src/GHC/TypeLits/Extra/Solver/Operations.hs +++ b/src/GHC/TypeLits/Extra/Solver/Operations.hs @@ -40,10 +40,17 @@ import GHC.TypeLits.Normalise.Unify (CType (..), normaliseNat, isNatural) -- GHC API +#if MIN_VERSION_ghc(9,0,0) +import GHC.Builtin.Types.Literals (typeNatExpTyCon, typeNatSubTyCon) +import GHC.Core.TyCon (TyCon) +import GHC.Core.Type (Type, TyVar, mkNumLitTy, mkTyConApp, mkTyVarTy) +import GHC.Utils.Outputable (Outputable (..), (<+>), integer, text) +#else import Outputable (Outputable (..), (<+>), integer, text) import TcTypeNats (typeNatExpTyCon, typeNatSubTyCon) import TyCon (TyCon) import Type (Type, TyVar, mkNumLitTy, mkTyConApp, mkTyVarTy) +#endif -- | Indicates whether normalisation has occured data Normalised = Normalised | Untouched diff --git a/src/GHC/TypeLits/Extra/Solver/Unify.hs b/src/GHC/TypeLits/Extra/Solver/Unify.hs --- a/src/GHC/TypeLits/Extra/Solver/Unify.hs +++ b/src/GHC/TypeLits/Extra/Solver/Unify.hs @@ -24,17 +24,26 @@ import GHC.TypeLits.Normalise.Unify (CType (..)) -- GHC API +#if MIN_VERSION_ghc(9,0,0) +import GHC.Builtin.Types.Literals (typeNatExpTyCon) +import GHC.Core.TyCo.Rep (Type (..), TyLit (..)) +import GHC.Core.Type (TyVar, coreView) +import GHC.Tc.Plugin (TcPluginM, tcPluginTrace) +import GHC.Tc.Types.Constraint (Ct) +import GHC.Types.Unique.Set (UniqSet, emptyUniqSet, unionUniqSets, unitUniqSet) +import GHC.Utils.Outputable (Outputable (..), ($$), text) +#else import Outputable (Outputable (..), ($$), text) import TcPluginM (TcPluginM, tcPluginTrace) import TcTypeNats (typeNatExpTyCon) import Type (TyVar, coreView) import TyCoRep (Type (..), TyLit (..)) import UniqSet (UniqSet, emptyUniqSet, unionUniqSets, unitUniqSet) - #if MIN_VERSION_ghc(8,10,0) import Constraint (Ct) #else import TcRnMonad (Ct) +#endif #endif -- internal diff --git a/tests/ErrorTests.hs b/tests/ErrorTests.hs --- a/tests/ErrorTests.hs +++ b/tests/ErrorTests.hs @@ -100,7 +100,110 @@ testFail27 :: Proxy n -> Proxy (n + 2 <=? Max (n + 1) 1) -> Proxy True testFail27 _ = id +#if __GLASGOW_HASKELL__ >= 900 testFail1Errors = + ["Expected: Proxy (GCD 6 8) -> Proxy 4" + ," Actual: Proxy 4 -> Proxy 4" + ] + +testFail2Errors = + ["Expected: Proxy (GCD 6 8 + x) -> Proxy (x + GCD 6 9)" + ," Actual: Proxy (GCD 6 8 + x) -> Proxy (GCD 6 8 + x)" + ] + +testFail3Errors = + ["Expected: Proxy (CLog 3 10) -> Proxy 2" + ," Actual: Proxy 2 -> Proxy 2" + ] + +testFail4Errors = + ["Expected: Proxy (CLog 3 10 + x) -> Proxy (x + CLog 2 9)" + ," Actual: Proxy (CLog 3 10 + x) -> Proxy (CLog 3 10 + x)" + ] + +testFail5Errors = + ["Expected: Proxy (CLog 0 4) -> Proxy 100" + ," Actual: Proxy 100 -> Proxy 100" + ] + +testFail6Errors = + ["Expected: Proxy (CLog 1 4) -> Proxy 100" + ," Actual: Proxy 100 -> Proxy 100" + ] + +testFail7Errors = + ["Expected: Proxy (CLog 4 0) -> Proxy 0" + ," Actual: Proxy 0 -> Proxy 0" + ] + +testFail8Errors = + ["Expected: Proxy (CLog 1 (1 ^ y)) -> Proxy y" + ," Actual: Proxy y -> Proxy y" + ] + +testFail9Errors = + ["Expected: Proxy (CLog 0 (0 ^ y)) -> Proxy y" + ," Actual: Proxy y -> Proxy y" + ] + +testFail12Errors = + ["Expected: Proxy (Div 4 0) -> Proxy 4" + ," Actual: Proxy 4 -> Proxy 4" + ] + +testFail13Errors = + ["Expected: Proxy (Mod 4 0) -> Proxy 4" + ," Actual: Proxy 4 -> Proxy 4" + ] + +testFail14Errors = + ["Expected: Proxy (FLog 0 4) -> Proxy 100" + ," Actual: Proxy 100 -> Proxy 100" + ] + +testFail15Errors = + ["Expected: Proxy (FLog 1 4) -> Proxy 100" + ," Actual: Proxy 100 -> Proxy 100" + ] + +testFail16Errors = + ["Expected: Proxy (FLog 4 0) -> Proxy 0" + ," Actual: Proxy 0 -> Proxy 0" + ] + +testFail17Errors = + ["Expected: Proxy (LCM 6 8) -> Proxy 48" + ," Actual: Proxy 48 -> Proxy 48" + ] + +testFail18Errors = + ["Expected: Proxy (LCM 6 8 + x) -> Proxy (x + LCM 6 9)" + ," Actual: Proxy (LCM 6 8 + x) -> Proxy (LCM 6 8 + x)" + ] + +testFail19Errors = + ["Couldn't match type: FLog 3 0" + ," with: CLog 3 0"] + +testFail20Errors = + ["Couldn't match type: FLog 3 10" + ," with: CLog 3 10"] + +testFail21Errors = + ["Expected: Proxy (Min a (a * b)) -> Proxy a" + ," Actual: Proxy a -> Proxy a" + ] + +testFail22Errors = + ["Expected: Proxy (Max a (a * b)) -> Proxy (a * b)" + ," Actual: Proxy (Max a (a * b)) -> Proxy (Max a (a * b))"] + +testFail27Errors = + ["Expected: Proxy ((n + 2) <=? Max (n + 1) 1) -> Proxy 'True" + ," Actual: Proxy 'True -> Proxy 'True" + ] +#else +testFail1Errors = ["Expected type: Proxy (GCD 6 8) -> Proxy 4" ,"Actual type: Proxy 4 -> Proxy 4" ] @@ -145,12 +248,6 @@ ,"Actual type: Proxy y -> Proxy y" ] -testFail10Errors = - ["Couldn't match type ‘'False’ with ‘'True’"] - -testFail11Errors = - ["Couldn't match type ‘CLog 2 4 <=? CLog 4 4’ with ‘'True’"] - testFail12Errors = ["Expected type: Proxy (Div 4 0) -> Proxy 4" ,"Actual type: Proxy 4 -> Proxy 4" @@ -201,6 +298,18 @@ ["Expected type: Proxy (Max a (a * b)) -> Proxy (a * b)" ,"Actual type: Proxy (a * b) -> Proxy (a * b)"] +testFail27Errors = + ["Expected type: Proxy ((n + 2) <=? Max (n + 1) 1) -> Proxy 'True" + ,"Actual type: Proxy 'True -> Proxy 'True" + ] +#endif + +testFail10Errors = + ["Couldn't match type ‘'False’ with ‘'True’"] + +testFail11Errors = + ["Couldn't match type ‘CLog 2 4 <=? CLog 4 4’ with ‘'True’"] + testFail23Errors = #if __GLASGOW_HASKELL__ >= 804 ["Couldn't match type ‘'True’ with ‘'False’"] @@ -217,9 +326,4 @@ testFail26Errors = ["Could not deduce: Max x y ~ n" ,"from the context: (x <=? n) ~ 'True" - ] - -testFail27Errors = - ["Expected type: Proxy ((n + 2) <=? Max (n + 1) 1) -> Proxy 'True" - ,"Actual type: Proxy 'True -> Proxy 'True" ]