{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE RoleAnnotations #-} {-# LANGUAGE ScopedTypeVariables #-} -- (c) The University of Glasgow 2012 -- | Module for coercion axioms, used to represent type family instances -- and newtypes module GHC.Core.Coercion.Axiom ( BranchFlag, Branched, Unbranched, BranchIndex, Branches(..), manyBranches, unbranched, fromBranches, numBranches, mapAccumBranches, CoAxiom(..), CoAxBranch(..), toBranchedAxiom, toUnbranchedAxiom, coAxiomName, coAxiomArity, coAxiomBranches, coAxiomTyCon, isImplicitCoAxiom, coAxiomNumPats, coAxiomNthBranch, coAxiomSingleBranch_maybe, coAxiomRole, coAxiomSingleBranch, coAxBranchTyVars, coAxBranchCoVars, coAxBranchRoles, coAxBranchLHS, coAxBranchRHS, coAxBranchSpan, coAxBranchIncomps, placeHolderIncomps, Role(..), fsFromRole, CoAxiomRule(..), TypeEqn, BuiltInSynFamily(..), trivialBuiltInFamily ) where import GHC.Prelude import {-# SOURCE #-} GHC.Core.TyCo.Rep ( Type ) import {-# SOURCE #-} GHC.Core.TyCo.Ppr ( pprType ) import {-# SOURCE #-} GHC.Core.TyCon ( TyCon ) import GHC.Utils.Outputable import GHC.Data.FastString import GHC.Types.Name import GHC.Types.Unique import GHC.Types.Var import GHC.Utils.Misc import GHC.Utils.Binary import GHC.Utils.Panic import GHC.Data.Pair import GHC.Types.Basic import Data.Typeable ( Typeable ) import GHC.Types.SrcLoc import qualified Data.Data as Data import Data.Array import Data.List ( mapAccumL ) #include "HsVersions.h" {- Note [Coercion axiom branches] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In order to allow closed type families, an axiom needs to contain an ordered list of alternatives, called branches. The kind of the coercion built from an axiom is determined by which index is used when building the coercion from the axiom. For example, consider the axiom derived from the following declaration: type family F a where F [Int] = Bool F [a] = Double F (a b) = Char This will give rise to this axiom: axF :: { F [Int] ~ Bool ; forall (a :: *). F [a] ~ Double ; forall (k :: *) (a :: k -> *) (b :: k). F (a b) ~ Char } The axiom is used with the AxiomInstCo constructor of Coercion. If we wish to have a coercion showing that F (Maybe Int) ~ Char, it will look like axF[2] <*> <Maybe> <Int> :: F (Maybe Int) ~ Char -- or, written using concrete-ish syntax -- AxiomInstCo axF 2 [Refl *, Refl Maybe, Refl Int] Note that the index is 0-based. For type-checking, it is also necessary to check that no previous pattern can unify with the supplied arguments. After all, it is possible that some of the type arguments are lambda-bound type variables whose instantiation may cause an earlier match among the branches. We wish to prohibit this behavior, so the type checker rules out the choice of a branch where a previous branch can unify. See also [Apartness] in GHC.Core.FamInstEnv. For example, the following is malformed, where 'a' is a lambda-bound type variable: axF[2] <*> <a> <Bool> :: F (a Bool) ~ Char Why? Because a might be instantiated with [], meaning that branch 1 should apply, not branch 2. This is a vital consistency check; without it, we could derive Int ~ Bool, and that is a Bad Thing. Note [Branched axioms] ~~~~~~~~~~~~~~~~~~~~~~ Although a CoAxiom has the capacity to store many branches, in certain cases, we want only one. These cases are in data/newtype family instances, newtype coercions, and type family instances. Furthermore, these unbranched axioms are used in a variety of places throughout GHC, and it would difficult to generalize all of that code to deal with branched axioms, especially when the code can be sure of the fact that an axiom is indeed a singleton. At the same time, it seems dangerous to assume singlehood in various places through GHC. The solution to this is to label a CoAxiom with a phantom type variable declaring whether it is known to be a singleton or not. The branches are stored using a special datatype, declared below, that ensures that the type variable is accurate. ************************************************************************ * * Branches * * ************************************************************************ -} type BranchIndex = Int -- The index of the branch in the list of branches -- Counting from zero -- promoted data type data BranchFlag = Branched | Unbranched type Branched = 'Branched type Unbranched = 'Unbranched -- By using type synonyms for the promoted constructors, we avoid needing -- DataKinds and the promotion quote in client modules. This also means that -- we don't need to export the term-level constructors, which should never be used. newtype Branches (br :: BranchFlag) = MkBranches { forall (br :: BranchFlag). Branches br -> Array BranchIndex CoAxBranch unMkBranches :: Array BranchIndex CoAxBranch } type role Branches nominal manyBranches :: [CoAxBranch] -> Branches Branched manyBranches :: [CoAxBranch] -> Branches Branched manyBranches [CoAxBranch] brs = ASSERT( snd bnds >= fst bnds ) forall (br :: BranchFlag). Array BranchIndex CoAxBranch -> Branches br MkBranches (forall i e. Ix i => (i, i) -> [e] -> Array i e listArray (BranchIndex, BranchIndex) bnds [CoAxBranch] brs) where bnds :: (BranchIndex, BranchIndex) bnds = (BranchIndex 0, forall (t :: * -> *) a. Foldable t => t a -> BranchIndex length [CoAxBranch] brs forall a. Num a => a -> a -> a - BranchIndex 1) unbranched :: CoAxBranch -> Branches Unbranched unbranched :: CoAxBranch -> Branches Unbranched unbranched CoAxBranch br = forall (br :: BranchFlag). Array BranchIndex CoAxBranch -> Branches br MkBranches (forall i e. Ix i => (i, i) -> [e] -> Array i e listArray (BranchIndex 0, BranchIndex 0) [CoAxBranch br]) toBranched :: Branches br -> Branches Branched toBranched :: forall (br :: BranchFlag). Branches br -> Branches Branched toBranched = forall (br :: BranchFlag). Array BranchIndex CoAxBranch -> Branches br MkBranches forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (br :: BranchFlag). Branches br -> Array BranchIndex CoAxBranch unMkBranches toUnbranched :: Branches br -> Branches Unbranched toUnbranched :: forall (br :: BranchFlag). Branches br -> Branches Unbranched toUnbranched (MkBranches Array BranchIndex CoAxBranch arr) = ASSERT( bounds arr == (0,0) ) forall (br :: BranchFlag). Array BranchIndex CoAxBranch -> Branches br MkBranches Array BranchIndex CoAxBranch arr fromBranches :: Branches br -> [CoAxBranch] fromBranches :: forall (br :: BranchFlag). Branches br -> [CoAxBranch] fromBranches = forall i e. Array i e -> [e] elems forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (br :: BranchFlag). Branches br -> Array BranchIndex CoAxBranch unMkBranches branchesNth :: Branches br -> BranchIndex -> CoAxBranch branchesNth :: forall (br :: BranchFlag). Branches br -> BranchIndex -> CoAxBranch branchesNth (MkBranches Array BranchIndex CoAxBranch arr) BranchIndex n = Array BranchIndex CoAxBranch arr forall i e. Ix i => Array i e -> i -> e ! BranchIndex n numBranches :: Branches br -> Int numBranches :: forall (br :: BranchFlag). Branches br -> BranchIndex numBranches (MkBranches Array BranchIndex CoAxBranch arr) = forall a b. (a, b) -> b snd (forall i e. Array i e -> (i, i) bounds Array BranchIndex CoAxBranch arr) forall a. Num a => a -> a -> a + BranchIndex 1 -- | The @[CoAxBranch]@ passed into the mapping function is a list of -- all previous branches, reversed mapAccumBranches :: ([CoAxBranch] -> CoAxBranch -> CoAxBranch) -> Branches br -> Branches br mapAccumBranches :: forall (br :: BranchFlag). ([CoAxBranch] -> CoAxBranch -> CoAxBranch) -> Branches br -> Branches br mapAccumBranches [CoAxBranch] -> CoAxBranch -> CoAxBranch f (MkBranches Array BranchIndex CoAxBranch arr) = forall (br :: BranchFlag). Array BranchIndex CoAxBranch -> Branches br MkBranches (forall i e. Ix i => (i, i) -> [e] -> Array i e listArray (forall i e. Array i e -> (i, i) bounds Array BranchIndex CoAxBranch arr) (forall a b. (a, b) -> b snd forall a b. (a -> b) -> a -> b $ forall (t :: * -> *) s a b. Traversable t => (s -> a -> (s, b)) -> s -> t a -> (s, t b) mapAccumL [CoAxBranch] -> CoAxBranch -> ([CoAxBranch], CoAxBranch) go [] (forall i e. Array i e -> [e] elems Array BranchIndex CoAxBranch arr))) where go :: [CoAxBranch] -> CoAxBranch -> ([CoAxBranch], CoAxBranch) go :: [CoAxBranch] -> CoAxBranch -> ([CoAxBranch], CoAxBranch) go [CoAxBranch] prev_branches CoAxBranch cur_branch = ( CoAxBranch cur_branch forall a. a -> [a] -> [a] : [CoAxBranch] prev_branches , [CoAxBranch] -> CoAxBranch -> CoAxBranch f [CoAxBranch] prev_branches CoAxBranch cur_branch ) {- ************************************************************************ * * Coercion axioms * * ************************************************************************ Note [Storing compatibility] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ During axiom application, we need to be aware of which branches are compatible with which others. The full explanation is in Note [Compatibility] in GHc.Core.FamInstEnv. (The code is placed there to avoid a dependency from GHC.Core.Coercion.Axiom on the unification algorithm.) Although we could theoretically compute compatibility on the fly, this is silly, so we store it in a CoAxiom. Specifically, each branch refers to all other branches with which it is incompatible. This list might well be empty, and it will always be for the first branch of any axiom. CoAxBranches that do not (yet) belong to a CoAxiom should have a panic thunk stored in cab_incomps. The incompatibilities are properly a property of the axiom as a whole, and they are computed only when the final axiom is built. During serialization, the list is converted into a list of the indices of the branches. Note [CoAxioms are homogeneous] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ All axioms must be *homogeneous*, meaning that the kind of the LHS must match the kind of the RHS. In practice, this means: Given a CoAxiom { co_ax_tc = ax_tc }, for every branch CoAxBranch { cab_lhs = lhs, cab_rhs = rhs }: typeKind (mkTyConApp ax_tc lhs) `eqType` typeKind rhs This is checked in FamInstEnv.mkCoAxBranch. -} -- | A 'CoAxiom' is a \"coercion constructor\", i.e. a named equality axiom. -- If you edit this type, you may need to update the GHC formalism -- See Note [GHC Formalism] in GHC.Core.Lint data CoAxiom br = CoAxiom -- Type equality axiom. { forall (br :: BranchFlag). CoAxiom br -> Unique co_ax_unique :: Unique -- Unique identifier , forall (br :: BranchFlag). CoAxiom br -> Name co_ax_name :: Name -- Name for pretty-printing , forall (br :: BranchFlag). CoAxiom br -> Role co_ax_role :: Role -- Role of the axiom's equality , forall (br :: BranchFlag). CoAxiom br -> TyCon co_ax_tc :: TyCon -- The head of the LHS patterns -- e.g. the newtype or family tycon , forall (br :: BranchFlag). CoAxiom br -> Branches br co_ax_branches :: Branches br -- The branches that form this axiom , forall (br :: BranchFlag). CoAxiom br -> Bool co_ax_implicit :: Bool -- True <=> the axiom is "implicit" -- See Note [Implicit axioms] -- INVARIANT: co_ax_implicit == True implies length co_ax_branches == 1. } data CoAxBranch = CoAxBranch { CoAxBranch -> SrcSpan cab_loc :: SrcSpan -- Location of the defining equation -- See Note [CoAxiom locations] , CoAxBranch -> [TyVar] cab_tvs :: [TyVar] -- Bound type variables; not necessarily fresh -- See Note [CoAxBranch type variables] , CoAxBranch -> [TyVar] cab_eta_tvs :: [TyVar] -- Eta-reduced tyvars -- cab_tvs and cab_lhs may be eta-reduced; see -- Note [Eta reduction for data families] , CoAxBranch -> [TyVar] cab_cvs :: [CoVar] -- Bound coercion variables -- Always empty, for now. -- See Note [Constraints in patterns] -- in GHC.Tc.TyCl , CoAxBranch -> [Role] cab_roles :: [Role] -- See Note [CoAxBranch roles] , CoAxBranch -> [Type] cab_lhs :: [Type] -- Type patterns to match against , CoAxBranch -> Type cab_rhs :: Type -- Right-hand side of the equality -- See Note [CoAxioms are homogeneous] , CoAxBranch -> [CoAxBranch] cab_incomps :: [CoAxBranch] -- The previous incompatible branches -- See Note [Storing compatibility] } deriving Typeable CoAxBranch CoAxBranch -> DataType CoAxBranch -> Constr (forall b. Data b => b -> b) -> CoAxBranch -> CoAxBranch forall a. Typeable a -> (forall (c :: * -> *). (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> a -> c a) -> (forall (c :: * -> *). (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c a) -> (a -> Constr) -> (a -> DataType) -> (forall (t :: * -> *) (c :: * -> *). Typeable t => (forall d. Data d => c (t d)) -> Maybe (c a)) -> (forall (t :: * -> * -> *) (c :: * -> *). Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a)) -> ((forall b. Data b => b -> b) -> a -> a) -> (forall r r'. (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r) -> (forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r) -> (forall u. (forall d. Data d => d -> u) -> a -> [u]) -> (forall u. BranchIndex -> (forall d. Data d => d -> u) -> a -> u) -> (forall (m :: * -> *). Monad m => (forall d. Data d => d -> m d) -> a -> m a) -> (forall (m :: * -> *). MonadPlus m => (forall d. Data d => d -> m d) -> a -> m a) -> (forall (m :: * -> *). MonadPlus m => (forall d. Data d => d -> m d) -> a -> m a) -> Data a forall u. BranchIndex -> (forall d. Data d => d -> u) -> CoAxBranch -> u forall u. (forall d. Data d => d -> u) -> CoAxBranch -> [u] forall r r'. (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> CoAxBranch -> r forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> CoAxBranch -> r forall (m :: * -> *). Monad m => (forall d. Data d => d -> m d) -> CoAxBranch -> m CoAxBranch forall (m :: * -> *). MonadPlus m => (forall d. Data d => d -> m d) -> CoAxBranch -> m CoAxBranch forall (c :: * -> *). (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c CoAxBranch forall (c :: * -> *). (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> CoAxBranch -> c CoAxBranch forall (t :: * -> *) (c :: * -> *). Typeable t => (forall d. Data d => c (t d)) -> Maybe (c CoAxBranch) forall (t :: * -> * -> *) (c :: * -> *). Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CoAxBranch) gmapMo :: forall (m :: * -> *). MonadPlus m => (forall d. Data d => d -> m d) -> CoAxBranch -> m CoAxBranch $cgmapMo :: forall (m :: * -> *). MonadPlus m => (forall d. Data d => d -> m d) -> CoAxBranch -> m CoAxBranch gmapMp :: forall (m :: * -> *). MonadPlus m => (forall d. Data d => d -> m d) -> CoAxBranch -> m CoAxBranch $cgmapMp :: forall (m :: * -> *). MonadPlus m => (forall d. Data d => d -> m d) -> CoAxBranch -> m CoAxBranch gmapM :: forall (m :: * -> *). Monad m => (forall d. Data d => d -> m d) -> CoAxBranch -> m CoAxBranch $cgmapM :: forall (m :: * -> *). Monad m => (forall d. Data d => d -> m d) -> CoAxBranch -> m CoAxBranch gmapQi :: forall u. BranchIndex -> (forall d. Data d => d -> u) -> CoAxBranch -> u $cgmapQi :: forall u. BranchIndex -> (forall d. Data d => d -> u) -> CoAxBranch -> u gmapQ :: forall u. (forall d. Data d => d -> u) -> CoAxBranch -> [u] $cgmapQ :: forall u. (forall d. Data d => d -> u) -> CoAxBranch -> [u] gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> CoAxBranch -> r $cgmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> CoAxBranch -> r gmapQl :: forall r r'. (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> CoAxBranch -> r $cgmapQl :: forall r r'. (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> CoAxBranch -> r gmapT :: (forall b. Data b => b -> b) -> CoAxBranch -> CoAxBranch $cgmapT :: (forall b. Data b => b -> b) -> CoAxBranch -> CoAxBranch dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *). Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CoAxBranch) $cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *). Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CoAxBranch) dataCast1 :: forall (t :: * -> *) (c :: * -> *). Typeable t => (forall d. Data d => c (t d)) -> Maybe (c CoAxBranch) $cdataCast1 :: forall (t :: * -> *) (c :: * -> *). Typeable t => (forall d. Data d => c (t d)) -> Maybe (c CoAxBranch) dataTypeOf :: CoAxBranch -> DataType $cdataTypeOf :: CoAxBranch -> DataType toConstr :: CoAxBranch -> Constr $ctoConstr :: CoAxBranch -> Constr gunfold :: forall (c :: * -> *). (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c CoAxBranch $cgunfold :: forall (c :: * -> *). (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c CoAxBranch gfoldl :: forall (c :: * -> *). (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> CoAxBranch -> c CoAxBranch $cgfoldl :: forall (c :: * -> *). (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> CoAxBranch -> c CoAxBranch Data.Data toBranchedAxiom :: CoAxiom br -> CoAxiom Branched toBranchedAxiom :: forall (br :: BranchFlag). CoAxiom br -> CoAxiom Branched toBranchedAxiom (CoAxiom Unique unique Name name Role role TyCon tc Branches br branches Bool implicit) = forall (br :: BranchFlag). Unique -> Name -> Role -> TyCon -> Branches br -> Bool -> CoAxiom br CoAxiom Unique unique Name name Role role TyCon tc (forall (br :: BranchFlag). Branches br -> Branches Branched toBranched Branches br branches) Bool implicit toUnbranchedAxiom :: CoAxiom br -> CoAxiom Unbranched toUnbranchedAxiom :: forall (br :: BranchFlag). CoAxiom br -> CoAxiom Unbranched toUnbranchedAxiom (CoAxiom Unique unique Name name Role role TyCon tc Branches br branches Bool implicit) = forall (br :: BranchFlag). Unique -> Name -> Role -> TyCon -> Branches br -> Bool -> CoAxiom br CoAxiom Unique unique Name name Role role TyCon tc (forall (br :: BranchFlag). Branches br -> Branches Unbranched toUnbranched Branches br branches) Bool implicit coAxiomNumPats :: CoAxiom br -> Int coAxiomNumPats :: forall (br :: BranchFlag). CoAxiom br -> BranchIndex coAxiomNumPats = forall (t :: * -> *) a. Foldable t => t a -> BranchIndex length forall b c a. (b -> c) -> (a -> b) -> a -> c . CoAxBranch -> [Type] coAxBranchLHS forall b c a. (b -> c) -> (a -> b) -> a -> c . (forall a b c. (a -> b -> c) -> b -> a -> c flip forall (br :: BranchFlag). CoAxiom br -> BranchIndex -> CoAxBranch coAxiomNthBranch BranchIndex 0) coAxiomNthBranch :: CoAxiom br -> BranchIndex -> CoAxBranch coAxiomNthBranch :: forall (br :: BranchFlag). CoAxiom br -> BranchIndex -> CoAxBranch coAxiomNthBranch (CoAxiom { co_ax_branches :: forall (br :: BranchFlag). CoAxiom br -> Branches br co_ax_branches = Branches br bs }) BranchIndex index = forall (br :: BranchFlag). Branches br -> BranchIndex -> CoAxBranch branchesNth Branches br bs BranchIndex index coAxiomArity :: CoAxiom br -> BranchIndex -> Arity coAxiomArity :: forall (br :: BranchFlag). CoAxiom br -> BranchIndex -> BranchIndex coAxiomArity CoAxiom br ax BranchIndex index = forall (t :: * -> *) a. Foldable t => t a -> BranchIndex length [TyVar] tvs forall a. Num a => a -> a -> a + forall (t :: * -> *) a. Foldable t => t a -> BranchIndex length [TyVar] cvs where CoAxBranch { cab_tvs :: CoAxBranch -> [TyVar] cab_tvs = [TyVar] tvs, cab_cvs :: CoAxBranch -> [TyVar] cab_cvs = [TyVar] cvs } = forall (br :: BranchFlag). CoAxiom br -> BranchIndex -> CoAxBranch coAxiomNthBranch CoAxiom br ax BranchIndex index coAxiomName :: CoAxiom br -> Name coAxiomName :: forall (br :: BranchFlag). CoAxiom br -> Name coAxiomName = forall (br :: BranchFlag). CoAxiom br -> Name co_ax_name coAxiomRole :: CoAxiom br -> Role coAxiomRole :: forall (br :: BranchFlag). CoAxiom br -> Role coAxiomRole = forall (br :: BranchFlag). CoAxiom br -> Role co_ax_role coAxiomBranches :: CoAxiom br -> Branches br coAxiomBranches :: forall (br :: BranchFlag). CoAxiom br -> Branches br coAxiomBranches = forall (br :: BranchFlag). CoAxiom br -> Branches br co_ax_branches coAxiomSingleBranch_maybe :: CoAxiom br -> Maybe CoAxBranch coAxiomSingleBranch_maybe :: forall (br :: BranchFlag). CoAxiom br -> Maybe CoAxBranch coAxiomSingleBranch_maybe (CoAxiom { co_ax_branches :: forall (br :: BranchFlag). CoAxiom br -> Branches br co_ax_branches = MkBranches Array BranchIndex CoAxBranch arr }) | forall a b. (a, b) -> b snd (forall i e. Array i e -> (i, i) bounds Array BranchIndex CoAxBranch arr) forall a. Eq a => a -> a -> Bool == BranchIndex 0 = forall a. a -> Maybe a Just forall a b. (a -> b) -> a -> b $ Array BranchIndex CoAxBranch arr forall i e. Ix i => Array i e -> i -> e ! BranchIndex 0 | Bool otherwise = forall a. Maybe a Nothing coAxiomSingleBranch :: CoAxiom Unbranched -> CoAxBranch coAxiomSingleBranch :: CoAxiom Unbranched -> CoAxBranch coAxiomSingleBranch (CoAxiom { co_ax_branches :: forall (br :: BranchFlag). CoAxiom br -> Branches br co_ax_branches = MkBranches Array BranchIndex CoAxBranch arr }) = Array BranchIndex CoAxBranch arr forall i e. Ix i => Array i e -> i -> e ! BranchIndex 0 coAxiomTyCon :: CoAxiom br -> TyCon coAxiomTyCon :: forall (br :: BranchFlag). CoAxiom br -> TyCon coAxiomTyCon = forall (br :: BranchFlag). CoAxiom br -> TyCon co_ax_tc coAxBranchTyVars :: CoAxBranch -> [TyVar] coAxBranchTyVars :: CoAxBranch -> [TyVar] coAxBranchTyVars = CoAxBranch -> [TyVar] cab_tvs coAxBranchCoVars :: CoAxBranch -> [CoVar] coAxBranchCoVars :: CoAxBranch -> [TyVar] coAxBranchCoVars = CoAxBranch -> [TyVar] cab_cvs coAxBranchLHS :: CoAxBranch -> [Type] coAxBranchLHS :: CoAxBranch -> [Type] coAxBranchLHS = CoAxBranch -> [Type] cab_lhs coAxBranchRHS :: CoAxBranch -> Type coAxBranchRHS :: CoAxBranch -> Type coAxBranchRHS = CoAxBranch -> Type cab_rhs coAxBranchRoles :: CoAxBranch -> [Role] coAxBranchRoles :: CoAxBranch -> [Role] coAxBranchRoles = CoAxBranch -> [Role] cab_roles coAxBranchSpan :: CoAxBranch -> SrcSpan coAxBranchSpan :: CoAxBranch -> SrcSpan coAxBranchSpan = CoAxBranch -> SrcSpan cab_loc isImplicitCoAxiom :: CoAxiom br -> Bool isImplicitCoAxiom :: forall (br :: BranchFlag). CoAxiom br -> Bool isImplicitCoAxiom = forall (br :: BranchFlag). CoAxiom br -> Bool co_ax_implicit coAxBranchIncomps :: CoAxBranch -> [CoAxBranch] coAxBranchIncomps :: CoAxBranch -> [CoAxBranch] coAxBranchIncomps = CoAxBranch -> [CoAxBranch] cab_incomps -- See Note [Compatibility checking] in GHC.Core.FamInstEnv placeHolderIncomps :: [CoAxBranch] placeHolderIncomps :: [CoAxBranch] placeHolderIncomps = forall a. String -> a panic String "placeHolderIncomps" {- Note [CoAxBranch type variables] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In the case of a CoAxBranch of an associated type-family instance, we use the *same* type variables (where possible) as the enclosing class or instance. Consider instance C Int [z] where type F Int [z] = ... -- Second param must be [z] In the CoAxBranch in the instance decl (F Int [z]) we use the same 'z', so that it's easy to check that that type is the same as that in the instance header. So, unlike FamInsts, there is no expectation that the cab_tvs are fresh wrt each other, or any other CoAxBranch. Note [CoAxBranch roles] ~~~~~~~~~~~~~~~~~~~~~~~ Consider this code: newtype Age = MkAge Int newtype Wrap a = MkWrap a convert :: Wrap Age -> Int convert (MkWrap (MkAge i)) = i We want this to compile to: NTCo:Wrap :: forall a. Wrap a ~R a NTCo:Age :: Age ~R Int convert = \x -> x |> (NTCo:Wrap[0] NTCo:Age[0]) But, note that NTCo:Age is at role R. Thus, we need to be able to pass coercions at role R into axioms. However, we don't *always* want to be able to do this, as it would be disastrous with type families. The solution is to annotate the arguments to the axiom with roles, much like we annotate tycon tyvars. Where do these roles get set? Newtype axioms inherit their roles from the newtype tycon; family axioms are all at role N. Note [CoAxiom locations] ~~~~~~~~~~~~~~~~~~~~~~~~ The source location of a CoAxiom is stored in two places in the datatype tree. * The first is in the location info buried in the Name of the CoAxiom. This span includes all of the branches of a branched CoAxiom. * The second is in the cab_loc fields of the CoAxBranches. In the case of a single branch, we can extract the source location of the branch from the name of the CoAxiom. In other cases, we need an explicit SrcSpan to correctly store the location of the equation giving rise to the FamInstBranch. Note [Implicit axioms] ~~~~~~~~~~~~~~~~~~~~~~ See also Note [Implicit TyThings] in GHC.Types.TyThing * A CoAxiom arising from data/type family instances is not "implicit". That is, it has its own IfaceAxiom declaration in an interface file * The CoAxiom arising from a newtype declaration *is* "implicit". That is, it does not have its own IfaceAxiom declaration in an interface file; instead the CoAxiom is generated by type-checking the newtype declaration Note [Eta reduction for data families] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider this data family T a b :: * newtype instance T Int a = MkT (IO a) deriving( Monad ) We'd like this to work. From the 'newtype instance' you might think we'd get: newtype TInt a = MkT (IO a) axiom ax1 a :: T Int a ~ TInt a -- The newtype-instance part axiom ax2 a :: TInt a ~ IO a -- The newtype part But now what can we do? We have this problem Given: d :: Monad IO Wanted: d' :: Monad (T Int) = d |> ???? What coercion can we use for the ??? Solution: eta-reduce both axioms, thus: axiom ax1 :: T Int ~ TInt axiom ax2 :: TInt ~ IO Now d' = d |> Monad (sym (ax2 ; ax1)) ----- Bottom line ------ For a CoAxBranch for a data family instance with representation TyCon rep_tc: - cab_tvs (of its CoAxiom) may be shorter than tyConTyVars of rep_tc. - cab_lhs may be shorter than tyConArity of the family tycon i.e. LHS is unsaturated - cab_rhs will be (rep_tc cab_tvs) i.e. RHS is un-saturated - This eta reduction happens for data instances as well as newtype instances. Here we want to eta-reduce the data family axiom. - This eta-reduction is done in GHC.Tc.TyCl.Instance.tcDataFamInstDecl. But for a /type/ family - cab_lhs has the exact arity of the family tycon There are certain situations (e.g., pretty-printing) where it is necessary to deal with eta-expanded data family instances. For these situations, the cab_eta_tvs field records the stuff that has been eta-reduced away. So if we have axiom forall a b. F [a->b] = D b a and cab_eta_tvs is [p,q], then the original user-written definition looked like axiom forall a b p q. F [a->b] p q = D b a p q (See #9692, #14179, and #15845 for examples of what can go wrong if we don't eta-expand when showing things to the user.) See also: * Note [Newtype eta] in GHC.Core.TyCon. This is notionally separate and deals with the axiom connecting a newtype with its representation type; but it too is eta-reduced. * Note [Implementing eta reduction for data families] in "GHC.Tc.TyCl.Instance". This describes the implementation details of this eta reduction happen. -} instance Eq (CoAxiom br) where CoAxiom br a == :: CoAxiom br -> CoAxiom br -> Bool == CoAxiom br b = forall a. Uniquable a => a -> Unique getUnique CoAxiom br a forall a. Eq a => a -> a -> Bool == forall a. Uniquable a => a -> Unique getUnique CoAxiom br b CoAxiom br a /= :: CoAxiom br -> CoAxiom br -> Bool /= CoAxiom br b = forall a. Uniquable a => a -> Unique getUnique CoAxiom br a forall a. Eq a => a -> a -> Bool /= forall a. Uniquable a => a -> Unique getUnique CoAxiom br b instance Uniquable (CoAxiom br) where getUnique :: CoAxiom br -> Unique getUnique = forall (br :: BranchFlag). CoAxiom br -> Unique co_ax_unique instance Outputable (CoAxiom br) where ppr :: CoAxiom br -> SDoc ppr = forall a. Outputable a => a -> SDoc ppr forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. NamedThing a => a -> Name getName instance NamedThing (CoAxiom br) where getName :: CoAxiom br -> Name getName = forall (br :: BranchFlag). CoAxiom br -> Name co_ax_name instance Typeable br => Data.Data (CoAxiom br) where -- don't traverse? toConstr :: CoAxiom br -> Constr toConstr CoAxiom br _ = String -> Constr abstractConstr String "CoAxiom" gunfold :: forall (c :: * -> *). (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (CoAxiom br) gunfold forall b r. Data b => c (b -> r) -> c r _ forall r. r -> c r _ = forall a. HasCallStack => String -> a error String "gunfold" dataTypeOf :: CoAxiom br -> DataType dataTypeOf CoAxiom br _ = String -> DataType mkNoRepType String "CoAxiom" instance Outputable CoAxBranch where ppr :: CoAxBranch -> SDoc ppr (CoAxBranch { cab_loc :: CoAxBranch -> SrcSpan cab_loc = SrcSpan loc , cab_lhs :: CoAxBranch -> [Type] cab_lhs = [Type] lhs , cab_rhs :: CoAxBranch -> Type cab_rhs = Type rhs }) = String -> SDoc text String "CoAxBranch" SDoc -> SDoc -> SDoc <+> SDoc -> SDoc parens (forall a. Outputable a => a -> SDoc ppr SrcSpan loc) SDoc -> SDoc -> SDoc <> SDoc colon SDoc -> SDoc -> SDoc <+> SDoc -> SDoc brackets ([SDoc] -> SDoc fsep (SDoc -> [SDoc] -> [SDoc] punctuate SDoc comma (forall a b. (a -> b) -> [a] -> [b] map Type -> SDoc pprType [Type] lhs))) SDoc -> SDoc -> SDoc <+> String -> SDoc text String "=>" SDoc -> SDoc -> SDoc <+> Type -> SDoc pprType Type rhs {- ************************************************************************ * * Roles * * ************************************************************************ Roles are defined here to avoid circular dependencies. -} -- See Note [Roles] in GHC.Core.Coercion -- defined here to avoid cyclic dependency with GHC.Core.Coercion -- -- Order of constructors matters: the Ord instance coincides with the *super*typing -- relation on roles. data Role = Nominal | Representational | Phantom deriving (Role -> Role -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Role -> Role -> Bool $c/= :: Role -> Role -> Bool == :: Role -> Role -> Bool $c== :: Role -> Role -> Bool Eq, Eq Role Role -> Role -> Bool Role -> Role -> Ordering Role -> Role -> Role forall a. Eq a -> (a -> a -> Ordering) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> a) -> (a -> a -> a) -> Ord a min :: Role -> Role -> Role $cmin :: Role -> Role -> Role max :: Role -> Role -> Role $cmax :: Role -> Role -> Role >= :: Role -> Role -> Bool $c>= :: Role -> Role -> Bool > :: Role -> Role -> Bool $c> :: Role -> Role -> Bool <= :: Role -> Role -> Bool $c<= :: Role -> Role -> Bool < :: Role -> Role -> Bool $c< :: Role -> Role -> Bool compare :: Role -> Role -> Ordering $ccompare :: Role -> Role -> Ordering Ord, Typeable Role Role -> DataType Role -> Constr (forall b. Data b => b -> b) -> Role -> Role forall a. Typeable a -> (forall (c :: * -> *). (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> a -> c a) -> (forall (c :: * -> *). (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c a) -> (a -> Constr) -> (a -> DataType) -> (forall (t :: * -> *) (c :: * -> *). Typeable t => (forall d. Data d => c (t d)) -> Maybe (c a)) -> (forall (t :: * -> * -> *) (c :: * -> *). Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a)) -> ((forall b. Data b => b -> b) -> a -> a) -> (forall r r'. (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r) -> (forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r) -> (forall u. (forall d. Data d => d -> u) -> a -> [u]) -> (forall u. BranchIndex -> (forall d. Data d => d -> u) -> a -> u) -> (forall (m :: * -> *). Monad m => (forall d. Data d => d -> m d) -> a -> m a) -> (forall (m :: * -> *). MonadPlus m => (forall d. Data d => d -> m d) -> a -> m a) -> (forall (m :: * -> *). MonadPlus m => (forall d. Data d => d -> m d) -> a -> m a) -> Data a forall u. BranchIndex -> (forall d. Data d => d -> u) -> Role -> u forall u. (forall d. Data d => d -> u) -> Role -> [u] forall r r'. (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Role -> r forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Role -> r forall (m :: * -> *). Monad m => (forall d. Data d => d -> m d) -> Role -> m Role forall (m :: * -> *). MonadPlus m => (forall d. Data d => d -> m d) -> Role -> m Role forall (c :: * -> *). (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Role forall (c :: * -> *). (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Role -> c Role forall (t :: * -> *) (c :: * -> *). Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Role) forall (t :: * -> * -> *) (c :: * -> *). Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Role) gmapMo :: forall (m :: * -> *). MonadPlus m => (forall d. Data d => d -> m d) -> Role -> m Role $cgmapMo :: forall (m :: * -> *). MonadPlus m => (forall d. Data d => d -> m d) -> Role -> m Role gmapMp :: forall (m :: * -> *). MonadPlus m => (forall d. Data d => d -> m d) -> Role -> m Role $cgmapMp :: forall (m :: * -> *). MonadPlus m => (forall d. Data d => d -> m d) -> Role -> m Role gmapM :: forall (m :: * -> *). Monad m => (forall d. Data d => d -> m d) -> Role -> m Role $cgmapM :: forall (m :: * -> *). Monad m => (forall d. Data d => d -> m d) -> Role -> m Role gmapQi :: forall u. BranchIndex -> (forall d. Data d => d -> u) -> Role -> u $cgmapQi :: forall u. BranchIndex -> (forall d. Data d => d -> u) -> Role -> u gmapQ :: forall u. (forall d. Data d => d -> u) -> Role -> [u] $cgmapQ :: forall u. (forall d. Data d => d -> u) -> Role -> [u] gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Role -> r $cgmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Role -> r gmapQl :: forall r r'. (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Role -> r $cgmapQl :: forall r r'. (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Role -> r gmapT :: (forall b. Data b => b -> b) -> Role -> Role $cgmapT :: (forall b. Data b => b -> b) -> Role -> Role dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *). Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Role) $cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *). Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Role) dataCast1 :: forall (t :: * -> *) (c :: * -> *). Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Role) $cdataCast1 :: forall (t :: * -> *) (c :: * -> *). Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Role) dataTypeOf :: Role -> DataType $cdataTypeOf :: Role -> DataType toConstr :: Role -> Constr $ctoConstr :: Role -> Constr gunfold :: forall (c :: * -> *). (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Role $cgunfold :: forall (c :: * -> *). (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Role gfoldl :: forall (c :: * -> *). (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Role -> c Role $cgfoldl :: forall (c :: * -> *). (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Role -> c Role Data.Data) -- These names are slurped into the parser code. Changing these strings -- will change the **surface syntax** that GHC accepts! If you want to -- change only the pretty-printing, do some replumbing. See -- mkRoleAnnotDecl in GHC.Parser.PostProcess fsFromRole :: Role -> FastString fsFromRole :: Role -> FastString fsFromRole Role Nominal = String -> FastString fsLit String "nominal" fsFromRole Role Representational = String -> FastString fsLit String "representational" fsFromRole Role Phantom = String -> FastString fsLit String "phantom" instance Outputable Role where ppr :: Role -> SDoc ppr = FastString -> SDoc ftext forall b c a. (b -> c) -> (a -> b) -> a -> c . Role -> FastString fsFromRole instance Binary Role where put_ :: BinHandle -> Role -> IO () put_ BinHandle bh Role Nominal = BinHandle -> Word8 -> IO () putByte BinHandle bh Word8 1 put_ BinHandle bh Role Representational = BinHandle -> Word8 -> IO () putByte BinHandle bh Word8 2 put_ BinHandle bh Role Phantom = BinHandle -> Word8 -> IO () putByte BinHandle bh Word8 3 get :: BinHandle -> IO Role get BinHandle bh = do Word8 tag <- BinHandle -> IO Word8 getByte BinHandle bh case Word8 tag of Word8 1 -> forall (m :: * -> *) a. Monad m => a -> m a return Role Nominal Word8 2 -> forall (m :: * -> *) a. Monad m => a -> m a return Role Representational Word8 3 -> forall (m :: * -> *) a. Monad m => a -> m a return Role Phantom Word8 _ -> forall a. String -> a panic (String "get Role " forall a. [a] -> [a] -> [a] ++ forall a. Show a => a -> String show Word8 tag) {- ************************************************************************ * * CoAxiomRule Rules for building Evidence * * ************************************************************************ Conditional axioms. The general idea is that a `CoAxiomRule` looks like this: forall as. (r1 ~ r2, s1 ~ s2) => t1 ~ t2 My intention is to reuse these for both (~) and (~#). The short-term plan is to use this datatype to represent the type-nat axioms. In the longer run, it may be good to unify this and `CoAxiom`, as `CoAxiom` is the special case when there are no assumptions. -} -- | A more explicit representation for `t1 ~ t2`. type TypeEqn = Pair Type -- | For now, we work only with nominal equality. data CoAxiomRule = CoAxiomRule { CoAxiomRule -> FastString coaxrName :: FastString , CoAxiomRule -> [Role] coaxrAsmpRoles :: [Role] -- roles of parameter equations , CoAxiomRule -> Role coaxrRole :: Role -- role of resulting equation , CoAxiomRule -> [TypeEqn] -> Maybe TypeEqn coaxrProves :: [TypeEqn] -> Maybe TypeEqn -- ^ coaxrProves returns @Nothing@ when it doesn't like -- the supplied arguments. When this happens in a coercion -- that means that the coercion is ill-formed, and Core Lint -- checks for that. } instance Data.Data CoAxiomRule where -- don't traverse? toConstr :: CoAxiomRule -> Constr toConstr CoAxiomRule _ = String -> Constr abstractConstr String "CoAxiomRule" gunfold :: forall (c :: * -> *). (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c CoAxiomRule gunfold forall b r. Data b => c (b -> r) -> c r _ forall r. r -> c r _ = forall a. HasCallStack => String -> a error String "gunfold" dataTypeOf :: CoAxiomRule -> DataType dataTypeOf CoAxiomRule _ = String -> DataType mkNoRepType String "CoAxiomRule" instance Uniquable CoAxiomRule where getUnique :: CoAxiomRule -> Unique getUnique = forall a. Uniquable a => a -> Unique getUnique forall b c a. (b -> c) -> (a -> b) -> a -> c . CoAxiomRule -> FastString coaxrName instance Eq CoAxiomRule where CoAxiomRule x == :: CoAxiomRule -> CoAxiomRule -> Bool == CoAxiomRule y = CoAxiomRule -> FastString coaxrName CoAxiomRule x forall a. Eq a => a -> a -> Bool == CoAxiomRule -> FastString coaxrName CoAxiomRule y instance Ord CoAxiomRule where -- we compare lexically to avoid non-deterministic output when sets of rules -- are printed compare :: CoAxiomRule -> CoAxiomRule -> Ordering compare CoAxiomRule x CoAxiomRule y = FastString -> FastString -> Ordering lexicalCompareFS (CoAxiomRule -> FastString coaxrName CoAxiomRule x) (CoAxiomRule -> FastString coaxrName CoAxiomRule y) instance Outputable CoAxiomRule where ppr :: CoAxiomRule -> SDoc ppr = forall a. Outputable a => a -> SDoc ppr forall b c a. (b -> c) -> (a -> b) -> a -> c . CoAxiomRule -> FastString coaxrName -- Type checking of built-in families data BuiltInSynFamily = BuiltInSynFamily { BuiltInSynFamily -> [Type] -> Maybe (CoAxiomRule, [Type], Type) sfMatchFam :: [Type] -> Maybe (CoAxiomRule, [Type], Type) -- Does this reduce on the given arguments? -- If it does, returns (CoAxiomRule, types to instantiate the rule at, rhs type) -- That is: mkAxiomRuleCo coax (zipWith mkReflCo (coaxrAsmpRoles coax) ts) -- :: F tys ~r rhs, -- where the r in the output is coaxrRole of the rule. It is up to the -- caller to ensure that this role is appropriate. , BuiltInSynFamily -> [Type] -> Type -> [TypeEqn] sfInteractTop :: [Type] -> Type -> [TypeEqn] -- If given these type arguments and RHS, returns the equalities that -- are guaranteed to hold. , BuiltInSynFamily -> [Type] -> Type -> [Type] -> Type -> [TypeEqn] sfInteractInert :: [Type] -> Type -> [Type] -> Type -> [TypeEqn] -- If given one set of arguments and result, and another set of arguments -- and result, returns the equalities that are guaranteed to hold. } -- Provides default implementations that do nothing. trivialBuiltInFamily :: BuiltInSynFamily trivialBuiltInFamily :: BuiltInSynFamily trivialBuiltInFamily = BuiltInSynFamily { sfMatchFam :: [Type] -> Maybe (CoAxiomRule, [Type], Type) sfMatchFam = \[Type] _ -> forall a. Maybe a Nothing , sfInteractTop :: [Type] -> Type -> [TypeEqn] sfInteractTop = \[Type] _ Type _ -> [] , sfInteractInert :: [Type] -> Type -> [Type] -> Type -> [TypeEqn] sfInteractInert = \[Type] _ Type _ [Type] _ Type _ -> [] }