Skip to content

Commit

Permalink
Add support for GHC 9.11.20240522
Browse files Browse the repository at this point in the history
  • Loading branch information
christiaanb committed May 27, 2024
1 parent 702dda2 commit 0d98c85
Show file tree
Hide file tree
Showing 24 changed files with 302 additions and 21 deletions.
4 changes: 4 additions & 0 deletions CHANGELOG.md
Original file line number Diff line number Diff line change
@@ -1,3 +1,7 @@
## 0.5
* Add `evByFiatWithDependencies`, see https://gitlab.haskell.org/ghc/ghc/-/merge_requests/12037 for more details.
* Added support for GHC 9.11.20240522

## 0.4.6 *May 22nd 2024*
* Added support for GHC-9.10.1
* Removed support for GHC 7.10
Expand Down
2 changes: 1 addition & 1 deletion defaults.dhall
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
{ name = "ghc-tcplugins-extra"
, version = "0.4.6"
, version = "0.5"
, synopsis = "Utilities for writing GHC type-checker plugins"
, description =
''
Expand Down
19 changes: 16 additions & 3 deletions ghc-tcplugins-extra.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,7 @@ cabal-version: 2.0
-- see: https://github.com/sol/hpack

name: ghc-tcplugins-extra
version: 0.4.6
version: 0.5
synopsis: Utilities for writing GHC type-checker plugins
description: Utilities for writing GHC type-checker plugins, such as
creating constraints, with a stable API covering multiple
Expand Down Expand Up @@ -55,7 +55,20 @@ library
ghc-options: -fhide-source-paths
if flag(deverror)
ghc-options: -Werror
if impl(ghc >= 9.10) && impl(ghc < 9.12)
if impl(ghc >= 9.11) && impl(ghc < 9.13)
other-modules:
GhcApi.Constraint
GhcApi.Predicate
GhcApi.GhcPlugins
Internal.Type
Internal.Constraint
Internal.Evidence
hs-source-dirs:
src-ghc-tree-9.4
src-ghc-9.12
build-depends:
ghc >=9.11 && <9.13
if impl(ghc >= 9.10) && impl(ghc < 9.11)
other-modules:
GhcApi.Constraint
GhcApi.Predicate
Expand All @@ -67,7 +80,7 @@ library
src-ghc-tree-9.4
src-ghc-9.10
build-depends:
ghc >=9.10 && <9.12
ghc ==9.10.*
if impl(ghc >= 9.8) && impl(ghc < 9.10)
other-modules:
GhcApi.Constraint
Expand Down
3 changes: 2 additions & 1 deletion package.dhall
Original file line number Diff line number Diff line change
Expand Up @@ -30,7 +30,8 @@ in let ghc = { name = "ghc", mixin = [] : List Text }
, exposed-modules = "GHC.TcPluginM.Extra"
, other-modules = "Internal"
, when =
[ version "9.10" "9.12" [ "tree-9.4", "9.10" ] ghc mods
[ version "9.11" "9.13" [ "tree-9.4", "9.12" ] ghc mods
, version "9.10" "9.11" [ "tree-9.4", "9.10" ] ghc mods
, version "9.8" "9.10" [ "tree-9.4", "9.8" ] ghc mods
, version "9.4" "9.8" [ "tree-9.4", "9.4" ] ghc mods
, version "9.2" "9.4" [ "tree", "9.2" ] ghc mods
Expand Down
13 changes: 12 additions & 1 deletion src-ghc-8.0/Internal/Evidence.hs
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
module Internal.Evidence (evByFiat) where
module Internal.Evidence (evByFiat, evByFiatWithDependencies) where

import TcEvidence (EvTerm(..))
import TyCoRep (UnivCoProvenance (..))
Expand All @@ -12,3 +12,14 @@ evByFiat :: String -- ^ Name the coercion should have
-> EvTerm
evByFiat name t1 t2 =
EvCoercion $ mkUnivCo (PluginProv name) Nominal t1 t2

-- | The 'EvTerm' equivalent for 'Unsafe.unsafeCoerce'
evByFiatWithDependencies ::
String -- ^ Name the coercion should have
-> VarSet -- ^ The set of all the in-scope coercion variables
-- that the proof makes use of.
-> Type -- ^ The LHS of the equivalence relation (~)
-> Type -- ^ The RHS of the equivalence relation (~)
-> EvTerm
evByFiatWithDependencies name _deps t1 t2 =
EvCoercion $ mkUnivCo (PluginProv name) Nominal t1 t2
13 changes: 12 additions & 1 deletion src-ghc-8.10/Internal/Evidence.hs
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
module Internal.Evidence (evByFiat) where
module Internal.Evidence (evByFiat, evByFiatWithDependencies) where

import TcEvidence (EvTerm(..))
import TyCoRep (UnivCoProvenance (..))
Expand All @@ -12,3 +12,14 @@ evByFiat :: String -- ^ Name the coercion should have
-> EvTerm
evByFiat name t1 t2 =
EvExpr $ Coercion $ mkUnivCo (PluginProv name) Nominal t1 t2

-- | The 'EvTerm' equivalent for 'Unsafe.unsafeCoerce'
evByFiatWithDependencies ::
String -- ^ Name the coercion should have
-> VarSet -- ^ The set of all the in-scope coercion variables
-- that the proof makes use of.
-> Type -- ^ The LHS of the equivalence relation (~)
-> Type -- ^ The RHS of the equivalence relation (~)
-> EvTerm
evByFiatWithDependencies name _deps t1 t2 =
EvExpr $ Coercion $ mkUnivCo (PluginProv name) Nominal t1 t2
13 changes: 12 additions & 1 deletion src-ghc-8.2/Internal/Evidence.hs
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
module Internal.Evidence (evByFiat) where
module Internal.Evidence (evByFiat, evByFiatWithDependencies) where

import TcEvidence (EvTerm(..))
import TyCoRep (UnivCoProvenance (..))
Expand All @@ -12,3 +12,14 @@ evByFiat :: String -- ^ Name the coercion should have
-> EvTerm
evByFiat name t1 t2 =
EvCoercion $ mkUnivCo (PluginProv name) Nominal t1 t2

-- | The 'EvTerm' equivalent for 'Unsafe.unsafeCoerce'
evByFiatWithDependencies ::
String -- ^ Name the coercion should have
-> VarSet -- ^ The set of all the in-scope coercion variables
-- that the proof makes use of.
-> Type -- ^ The LHS of the equivalence relation (~)
-> Type -- ^ The RHS of the equivalence relation (~)
-> EvTerm
evByFiatWithDependencies name _deps t1 t2 =
EvCoercion $ mkUnivCo (PluginProv name) Nominal t1 t2
13 changes: 12 additions & 1 deletion src-ghc-8.4/Internal/Evidence.hs
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
module Internal.Evidence (evByFiat) where
module Internal.Evidence (evByFiat, evByFiatWithDependencies) where

import TcEvidence (EvTerm(..))
import TyCoRep (UnivCoProvenance (..))
Expand All @@ -12,3 +12,14 @@ evByFiat :: String -- ^ Name the coercion should have
-> EvTerm
evByFiat name t1 t2 =
EvCoercion $ mkUnivCo (PluginProv name) Nominal t1 t2

-- | The 'EvTerm' equivalent for 'Unsafe.unsafeCoerce'
evByFiatWithDependencies ::
String -- ^ Name the coercion should have
-> VarSet -- ^ The set of all the in-scope coercion variables
-- that the proof makes use of.
-> Type -- ^ The LHS of the equivalence relation (~)
-> Type -- ^ The RHS of the equivalence relation (~)
-> EvTerm
evByFiatWithDependencies name _deps t1 t2 =
EvCoercion $ mkUnivCo (PluginProv name) Nominal t1 t2
13 changes: 12 additions & 1 deletion src-ghc-8.6/Internal/Evidence.hs
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
module Internal.Evidence (evByFiat) where
module Internal.Evidence (evByFiat, evByFiatWithDependencies) where

import TcEvidence (EvTerm(..))
import TyCoRep (UnivCoProvenance (..))
Expand All @@ -12,3 +12,14 @@ evByFiat :: String -- ^ Name the coercion should have
-> EvTerm
evByFiat name t1 t2 =
EvExpr $ Coercion $ mkUnivCo (PluginProv name) Nominal t1 t2

-- | The 'EvTerm' equivalent for 'Unsafe.unsafeCoerce'
evByFiatWithDependencies ::
String -- ^ Name the coercion should have
-> VarSet -- ^ The set of all the in-scope coercion variables
-- that the proof makes use of.
-> Type -- ^ The LHS of the equivalence relation (~)
-> Type -- ^ The RHS of the equivalence relation (~)
-> EvTerm
evByFiatWithDependencies name _deps t1 t2 =
EvExpr $ Coercion $ mkUnivCo (PluginProv name) Nominal t1 t2
13 changes: 12 additions & 1 deletion src-ghc-8.8/Internal/Evidence.hs
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
module Internal.Evidence (evByFiat) where
module Internal.Evidence (evByFiat, evByFiatWithDependencies) where

import TcEvidence (EvTerm(..))
import TyCoRep (UnivCoProvenance (..))
Expand All @@ -12,3 +12,14 @@ evByFiat :: String -- ^ Name the coercion should have
-> EvTerm
evByFiat name t1 t2 =
EvExpr $ Coercion $ mkUnivCo (PluginProv name) Nominal t1 t2

-- | The 'EvTerm' equivalent for 'Unsafe.unsafeCoerce'
evByFiatWithDependencies ::
String -- ^ Name the coercion should have
-> VarSet -- ^ The set of all the in-scope coercion variables
-- that the proof makes use of.
-> Type -- ^ The LHS of the equivalence relation (~)
-> Type -- ^ The RHS of the equivalence relation (~)
-> EvTerm
evByFiatWithDependencies name _deps t1 t2 =
EvExpr $ Coercion $ mkUnivCo (PluginProv name) Nominal t1 t2
15 changes: 13 additions & 2 deletions src-ghc-9.0/Internal/Evidence.hs
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
module Internal.Evidence (evByFiat) where
module Internal.Evidence (evByFiat, evByFiatWithDependencies) where

import GHC.Tc.Types.Evidence (EvTerm(..))
import GHC.Core.TyCo.Rep (UnivCoProvenance (..))
Expand All @@ -11,4 +11,15 @@ evByFiat :: String -- ^ Name the coercion should have
-> Type -- ^ The RHS of the equivalence relation (~)
-> EvTerm
evByFiat name t1 t2 =
EvExpr $ Coercion $ mkUnivCo (PluginProv name) Nominal t1 t2
EvExpr $ Coercion $ mkUnivCo (PluginProv name) Nominal t1 t2

-- | The 'EvTerm' equivalent for 'Unsafe.unsafeCoerce'
evByFiatWithDependencies ::
String -- ^ Name the coercion should have
-> VarSet -- ^ The set of all the in-scope coercion variables
-- that the proof makes use of.
-> Type -- ^ The LHS of the equivalence relation (~)
-> Type -- ^ The RHS of the equivalence relation (~)
-> EvTerm
evByFiatWithDependencies name _deps t1 t2 =
EvExpr $ Coercion $ mkUnivCo (PluginProv name) Nominal t1 t2
13 changes: 12 additions & 1 deletion src-ghc-9.10/Internal/Evidence.hs
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
module Internal.Evidence (evByFiat) where
module Internal.Evidence (evByFiat, evByFiatWithDependencies) where

import GHC.Tc.Types.Evidence (EvTerm(..))
import GHC.Core.TyCo.Rep (UnivCoProvenance (..))
Expand All @@ -12,3 +12,14 @@ evByFiat :: String -- ^ Name the coercion should have
-> EvTerm
evByFiat name t1 t2 =
EvExpr $ Coercion $ mkUnivCo (PluginProv name) Nominal t1 t2

-- | The 'EvTerm' equivalent for 'Unsafe.unsafeCoerce'
evByFiatWithDependencies ::
String -- ^ Name the coercion should have
-> VarSet -- ^ The set of all the in-scope coercion variables
-- that the proof makes use of.
-> Type -- ^ The LHS of the equivalence relation (~)
-> Type -- ^ The RHS of the equivalence relation (~)
-> EvTerm
evByFiatWithDependencies name _deps t1 t2 =
EvExpr $ Coercion $ mkUnivCo (PluginProv name) Nominal t1 t2
13 changes: 13 additions & 0 deletions src-ghc-9.12/GhcApi/Constraint.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,13 @@
module GhcApi.Constraint
( Ct(..)
, CtEvidence(..)
, CtLoc
, CanEqLHS(..)
, ctLoc
, ctEvId
, mkNonCanonical
)
where

import GHC.Tc.Types.Constraint
(Ct (..), CtEvidence (..), CanEqLHS (..), CtLoc, ctLoc, ctEvId, mkNonCanonical)
5 changes: 5 additions & 0 deletions src-ghc-9.12/GhcApi/GhcPlugins.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,5 @@
module GhcApi.GhcPlugins (module GHC.Plugins, FindResult(..), findPluginModule) where

import GHC.Plugins hiding (TcPlugin)
import GHC.Unit.Finder (findPluginModule)
import GHC.Tc.Plugin (FindResult(..))
64 changes: 64 additions & 0 deletions src-ghc-9.12/Internal/Constraint.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,64 @@
{-# LANGUAGE RecordWildCards #-}

module Internal.Constraint (newGiven, flatToCt, mkSubst, overEvidencePredType) where

import GhcApi.GhcPlugins
import GhcApi.Constraint
(Ct(..), CtEvidence(..), CanEqLHS(..), CtLoc, ctLoc, ctEvId, mkNonCanonical)

import GHC.Tc.Utils.TcType (TcType)
import GHC.Tc.Types.Constraint (DictCt(..), IrredCt(..), EqCt(..), QCInst(..))
import GHC.Tc.Types.Evidence (EvTerm(..), EvBindsVar)
import GHC.Tc.Plugin (TcPluginM)
import qualified GHC.Tc.Plugin as TcPlugin (newGiven)

-- | Create a new [G]iven constraint, with the supplied evidence. This must not
-- be invoked from 'tcPluginInit' or 'tcPluginStop', or it will panic.
newGiven :: EvBindsVar -> CtLoc -> PredType -> EvTerm -> TcPluginM CtEvidence
newGiven tcEvbinds loc pty (EvExpr ev) = TcPlugin.newGiven tcEvbinds loc pty ev
newGiven _ _ _ ev = panicDoc "newGiven: not an EvExpr: " (ppr ev)

flatToCt :: [((TcTyVar,TcType),Ct)] -> Maybe Ct
flatToCt [((_,lhs),ct),((_,rhs),_)]
= Just
$ mkNonCanonical
$ CtGiven (mkPrimEqPred lhs rhs)
(ctEvId ct)
(ctLoc ct)

flatToCt _ = Nothing

-- | Create simple substitution from type equalities
mkSubst :: Ct -> Maybe ((TcTyVar, TcType),Ct)
mkSubst ct@(CEqCan (EqCt {..}))
| TyVarLHS tyvar <- eq_lhs
= Just ((tyvar,eq_rhs),ct)
mkSubst _ = Nothing

-- | Modify the predicate type of the evidence term of a constraint
overEvidencePredType :: (TcType -> TcType) -> Ct -> Ct
overEvidencePredType f (CDictCan di) =
let
ev :: CtEvidence
ev = di_ev di
in CDictCan ( di { di_ev = ev { ctev_pred = f (ctev_pred ev) } } )
overEvidencePredType f (CIrredCan ir) =
let
ev :: CtEvidence
ev = ir_ev ir
in CIrredCan ( ir { ir_ev = ev { ctev_pred = f (ctev_pred ev) } } )
overEvidencePredType f (CEqCan eq) =
let
ev :: CtEvidence
ev = eq_ev eq
in CEqCan ( eq { eq_ev = ev { ctev_pred = f (ctev_pred ev) } } )
overEvidencePredType f (CNonCanonical ct) =
let
ev :: CtEvidence
ev = ct
in CNonCanonical ( ev { ctev_pred = f (ctev_pred ev) } )
overEvidencePredType f (CQuantCan qci) =
let
ev :: CtEvidence
ev = qci_ev qci
in CQuantCan ( qci { qci_ev = ev { ctev_pred = f (ctev_pred ev) } } )
26 changes: 26 additions & 0 deletions src-ghc-9.12/Internal/Evidence.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,26 @@
module Internal.Evidence (evByFiat, evByFiatWithDependencies) where

import GHC.Tc.Types.Evidence (EvTerm(..))
import GHC.Core.TyCo.Rep (UnivCoProvenance (..))

import GhcApi.GhcPlugins

-- | The 'EvTerm' equivalent for 'Unsafe.unsafeCoerce'
evByFiat :: String -- ^ Name the coercion should have
-> Type -- ^ The LHS of the equivalence relation (~)
-> Type -- ^ The RHS of the equivalence relation (~)
-> EvTerm
evByFiat name t1 t2 =
EvExpr $ Coercion $ mkUnivCo (PluginProv name emptyDVarSet) Nominal t1 t2
{-# DEPRECATED evByFiat "'evByFiat' creates proofs that can lead to unsoundness, use 'evByFiatWithDependencies' instead.\nSee also https://gitlab.haskell.org/ghc/ghc/-/merge_requests/12037" #-}

-- | The 'EvTerm' equivalent for 'Unsafe.unsafeCoerce'
evByFiatWithDependencies ::
String -- ^ Name the coercion should have
-> DCoVarSet -- ^ The set of all the in-scope coercion variables
-- that the proof makes use of.
-> Type -- ^ The LHS of the equivalence relation (~)
-> Type -- ^ The RHS of the equivalence relation (~)
-> EvTerm
evByFiatWithDependencies name deps t1 t2 =
EvExpr $ Coercion $ mkUnivCo (PluginProv name deps) Nominal t1 t2
30 changes: 30 additions & 0 deletions src-ghc-9.12/Internal/Type.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,30 @@
module Internal.Type (substType) where

import Data.Maybe (fromMaybe)
import GHC.Tc.Utils.TcType (TcType)
import GHC.Core.TyCo.Rep (Type (..))
import GHC.Types.Var (TcTyVar)

-- | Apply substitutions in Types
--
-- __NB:__ Doesn't substitute under binders
substType
:: [(TcTyVar, TcType)]
-> TcType
-> TcType
substType subst tv@(TyVarTy v) =
fromMaybe tv (lookup v subst)
substType subst (AppTy t1 t2) =
AppTy (substType subst t1) (substType subst t2)
substType subst (TyConApp tc xs) =
TyConApp tc (map (substType subst) xs)
substType _subst t@(ForAllTy _tv _ty) =
-- TODO: Is it safe to do "dumb" substitution under binders?
-- ForAllTy tv (substType subst ty)
t
substType subst (FunTy k1 k2 t1 t2) =
FunTy k1 k2 (substType subst t1) (substType subst t2)
substType _ l@(LitTy _) = l
substType subst (CastTy ty co) =
CastTy (substType subst ty) co
substType _ co@(CoercionTy _) = co
Loading

0 comments on commit 0d98c85

Please sign in to comment.