polysemy-plugin 0.4.4.0 → 0.4.5.0
raw patch · 4 files changed
+43/−18 lines, 4 filesdep ~doctestdep ~inspection-testingdep ~transformers
Dependency ranges changed: doctest, inspection-testing, transformers
Files
- ChangeLog.md +6/−0
- polysemy-plugin.cabal +8/−8
- src/Polysemy/Plugin/Fundep.hs +19/−8
- src/Polysemy/Plugin/Fundep/Unification.hs +10/−2
ChangeLog.md view
@@ -2,6 +2,12 @@ ## Unreleased +## 0.4.5.0 (2023-04-09)++### Other Changes++* Support GHC 9.6+ ## 0.4.4.0 (2022-12-27) * Support GHC 9.4
polysemy-plugin.cabal view
@@ -1,11 +1,11 @@ cabal-version: 2.0 --- This file has been generated from package.yaml by hpack version 0.34.7.+-- This file has been generated from package.yaml by hpack version 0.35.2. -- -- see: https://github.com/sol/hpack name: polysemy-plugin-version: 0.4.4.0+version: 0.4.5.0 synopsis: Disambiguate obvious uses of effects. description: Please see the README on GitHub at <https://github.com/polysemy-research/polysemy/tree/master/polysemy-plugin#readme> category: Polysemy@@ -27,7 +27,7 @@ custom-setup setup-depends:- Cabal+ Cabal <3.11 , base >=4.9 && <5 , cabal-doctest >=1.0.6 && <1.1 @@ -70,7 +70,7 @@ , ghc-tcplugins-extra >=0.3 && <0.5 , polysemy >=1.7 , syb ==0.7.*- , transformers >=0.5.2.0 && <0.6+ , transformers >=0.5.2.0 && <0.7 default-language: Haskell2010 test-suite polysemy-plugin-test@@ -111,17 +111,17 @@ build-depends: base >=4.9 && <5 , containers >=0.5 && <0.7- , doctest >=0.16.0.1 && <0.21+ , doctest >=0.16.0.1 && <0.22 , ghc >=8.6.5 && <10 , ghc-tcplugins-extra >=0.3 && <0.5 , hspec >=2.6.0 && <3 , hspec-discover- , inspection-testing >=0.4.2 && <0.5+ , inspection-testing >=0.4.2 && <0.6 , polysemy >=1.3.0.0 , polysemy-plugin , should-not-typecheck >=2.1.0 && <3 , syb ==0.7.*- , transformers >=0.5.2.0 && <0.6+ , transformers >=0.5.2.0 && <0.7+ default-language: Haskell2010 if flag(corelint) ghc-options: -dcore-lint -dsuppress-all- default-language: Haskell2010
src/Polysemy/Plugin/Fundep.hs view
@@ -52,6 +52,16 @@ import Polysemy.Plugin.Fundep.Unification import Polysemy.Plugin.Fundep.Utils +#if __GLASGOW_HASKELL__ >= 906+#define SUBST Subst+#define GET_TYVAR getTyVar_maybe+import GHC.Core.TyCo.Subst (SUBST)+import GHC.Core.TyCo.Compare (eqType, nonDetCmpType)+#else+#define SUBST TCvSubst+#define GET_TYVAR tcGetTyVar_maybe+#endif+ #if __GLASGOW_HASKELL__ >= 900 import GHC.Builtin.Types.Prim (alphaTys) import GHC.Plugins (idType, tyConClass_maybe, ppr, Outputable, sep, text, (<+>), parens, emptyUFM)@@ -60,7 +70,7 @@ import GHC.Tc.Types import GHC.Tc.Types.Constraint import GHC.Tc.Utils.Env (tcGetInstEnvs)-import GHC.Tc.Utils.TcType (tcSplitPhiTy, tcSplitTyConApp, tcGetTyVar_maybe, tcSplitAppTy_maybe)+import GHC.Tc.Utils.TcType (tcSplitPhiTy, tcSplitTyConApp, GET_TYVAR, tcSplitAppTy_maybe) import GHC.Tc.Solver.Monad hiding (tcLookupClass) import GHC.Core.Class (classTyCon) import GHC.Core.InstEnv (lookupInstEnv, is_dfun)@@ -80,14 +90,12 @@ import TcEvidence import TcPluginM (tcPluginIO) import TcRnTypes-import TcType (tcSplitPhiTy, tcSplitTyConApp, tcGetTyVar_maybe, tcSplitAppTy_maybe)+import TcType (tcSplitPhiTy, tcSplitTyConApp, GET_TYVAR, tcSplitAppTy_maybe) import TcSMonad hiding (tcLookupClass) import Type import TysPrim (alphaTys) #endif -- fundepPlugin :: TcPlugin fundepPlugin = TcPlugin { tcPluginInit =@@ -193,12 +201,15 @@ True -> pure $ Just eff False -> pure Nothing - ------------------------------------------------------------------------------ -- | @checkExtraEvidence givens subst c@ returns 'True' iff we can prove that -- the constraint @c@ holds under the substitution @subst@ in the context of -- @givens@.-checkExtraEvidence :: Set PredType' -> TCvSubst -> PredType -> TcM Bool+checkExtraEvidence ::+ Set PredType' ->+ SUBST ->+ PredType ->+ TcM Bool checkExtraEvidence givens subst = flip evalStateT givens . getInstance . substTy subst @@ -240,8 +251,8 @@ skolemsForInterpreter :: Type -> Set TyVar skolemsForInterpreter ty = case tcSplitAppTy_maybe ty of- Just (tcGetTyVar_maybe -> Just skolem, _) -> S.singleton skolem- _ -> maybe mempty S.singleton $ tcGetTyVar_maybe ty+ Just (GET_TYVAR -> Just skolem, _) -> S.singleton skolem+ _ -> maybe mempty S.singleton $ GET_TYVAR ty ------------------------------------------------------------------------------
src/Polysemy/Plugin/Fundep/Unification.hs view
@@ -25,7 +25,15 @@ import GhcPlugins (Outputable, ppr, parens, text, (<+>)) #endif +#if __GLASGOW_HASKELL__ >= 906+#define SUBST Subst+import GHC.Core.TyCo.Subst (SUBST)+import GHC.Core.TyCo.Compare (eqType, nonDetCmpType)+#else+#define SUBST TCvSubst+#endif + ------------------------------------------------------------------------------ -- | The context in which we're attempting to solve a constraint. data SolveContext@@ -64,7 +72,7 @@ :: SolveContext -> Type -- ^ wanted -> Type -- ^ given- -> Maybe TCvSubst+ -> Maybe SUBST unify solve_ctx = tryUnifyUnivarsButNotSkolems skolems where skolems :: Set TyVar@@ -81,7 +89,7 @@ #define APART Skolem #endif -tryUnifyUnivarsButNotSkolems :: Set TyVar -> Type -> Type -> Maybe TCvSubst+tryUnifyUnivarsButNotSkolems :: Set TyVar -> Type -> Type -> Maybe SUBST tryUnifyUnivarsButNotSkolems skolems goal inst = case tcUnifyTysFG (bool BINDME APART . flip S.member skolems)