{-# LANGUAGE RecordWildCards #-}
module Internal.Constraint (newGiven, flatToCt, mkSubst, overEvidencePredType) where
import GhcApi.GhcPlugins
import GhcApi.Constraint
(Ct(..), CtEvidence(..), CtLoc, ctLoc, ctEvId, mkNonCanonical)
import GHC.Tc.Utils.TcType (TcType)
import GHC.Core.TyCo.Rep (Type (..))
import GHC.Tc.Types.Constraint (QCInst(..))
import GHC.Tc.Types.Evidence (EvTerm(..))
import GHC.Tc.Plugin (TcPluginM)
import qualified GHC.Tc.Plugin as TcPlugin (newGiven)
newGiven :: CtLoc -> PredType -> EvTerm -> TcPluginM CtEvidence
newGiven :: CtLoc -> PredType -> EvTerm -> TcPluginM CtEvidence
newGiven CtLoc
loc PredType
pty (EvExpr EvExpr
ev) = CtLoc -> PredType -> EvExpr -> TcPluginM CtEvidence
TcPlugin.newGiven CtLoc
loc PredType
pty EvExpr
ev
newGiven CtLoc
_ PredType
_ EvTerm
ev = String -> SDoc -> TcPluginM CtEvidence
forall a. String -> SDoc -> a
panicDoc String
"newGiven: not an EvExpr: " (EvTerm -> SDoc
forall a. Outputable a => a -> SDoc
ppr EvTerm
ev)
flatToCt :: [((TcTyVar,TcType),Ct)] -> Maybe Ct
flatToCt :: [((TcTyVar, PredType), Ct)] -> Maybe Ct
flatToCt [((TcTyVar
_,PredType
lhs),Ct
ct),((TcTyVar
_,PredType
rhs),Ct
_)]
= Ct -> Maybe Ct
forall a. a -> Maybe a
Just
(Ct -> Maybe Ct) -> Ct -> Maybe Ct
forall a b. (a -> b) -> a -> b
$ CtEvidence -> Ct
mkNonCanonical
(CtEvidence -> Ct) -> CtEvidence -> Ct
forall a b. (a -> b) -> a -> b
$ PredType -> TcTyVar -> CtLoc -> CtEvidence
CtGiven (PredType -> PredType -> PredType
mkPrimEqPred PredType
lhs PredType
rhs)
(Ct -> TcTyVar
ctEvId Ct
ct)
(Ct -> CtLoc
ctLoc Ct
ct)
flatToCt [((TcTyVar, PredType), Ct)]
_ = Maybe Ct
forall a. Maybe a
Nothing
mkSubst :: Ct -> Maybe ((TcTyVar, TcType),Ct)
mkSubst :: Ct -> Maybe ((TcTyVar, PredType), Ct)
mkSubst ct :: Ct
ct@(CTyEqCan {CtEvidence
EqRel
PredType
TcTyVar
cc_eq_rel :: Ct -> EqRel
cc_ev :: Ct -> CtEvidence
cc_rhs :: Ct -> PredType
cc_tyvar :: Ct -> TcTyVar
cc_eq_rel :: EqRel
cc_rhs :: PredType
cc_tyvar :: TcTyVar
cc_ev :: CtEvidence
..}) = ((TcTyVar, PredType), Ct) -> Maybe ((TcTyVar, PredType), Ct)
forall a. a -> Maybe a
Just ((TcTyVar
cc_tyvar,PredType
cc_rhs),Ct
ct)
mkSubst ct :: Ct
ct@(CFunEqCan {[PredType]
CtEvidence
TyCon
TcTyVar
cc_fsk :: Ct -> TcTyVar
cc_fun :: Ct -> TyCon
cc_tyargs :: Ct -> [PredType]
cc_fsk :: TcTyVar
cc_tyargs :: [PredType]
cc_fun :: TyCon
cc_ev :: CtEvidence
cc_ev :: Ct -> CtEvidence
..}) = ((TcTyVar, PredType), Ct) -> Maybe ((TcTyVar, PredType), Ct)
forall a. a -> Maybe a
Just ((TcTyVar
cc_fsk,TyCon -> [PredType] -> PredType
TyConApp TyCon
cc_fun [PredType]
cc_tyargs),Ct
ct)
mkSubst Ct
_ = Maybe ((TcTyVar, PredType), Ct)
forall a. Maybe a
Nothing
overEvidencePredType :: (TcType -> TcType) -> Ct -> Ct
overEvidencePredType :: (PredType -> PredType) -> Ct -> Ct
overEvidencePredType PredType -> PredType
f (CQuantCan QCInst
qci) =
let
ev :: CtEvidence
ev :: CtEvidence
ev = QCInst -> CtEvidence
qci_ev QCInst
qci
in QCInst -> Ct
CQuantCan ( QCInst
qci { qci_ev :: CtEvidence
qci_ev = CtEvidence
ev { ctev_pred :: PredType
ctev_pred = PredType -> PredType
f (CtEvidence -> PredType
ctev_pred CtEvidence
ev) } } )
overEvidencePredType PredType -> PredType
f Ct
ct =
let
ev :: CtEvidence
ev :: CtEvidence
ev = Ct -> CtEvidence
cc_ev Ct
ct
in Ct
ct { cc_ev :: CtEvidence
cc_ev = CtEvidence
ev { ctev_pred :: PredType
ctev_pred = PredType -> PredType
f (CtEvidence -> PredType
ctev_pred CtEvidence
ev) } }