Commit 25881af0 authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

Move tcLookupFamInst, tcLookupDataFamInst from TcEnv to FamInst

This is just a refactoring
parent 12d2089e
......@@ -2,12 +2,15 @@ The @FamInst@ type: family instance heads
\begin{code}
module FamInst (
checkFamInstConsistency, tcExtendLocalFamInstEnv, tcGetFamInstEnvs
checkFamInstConsistency, tcExtendLocalFamInstEnv,
tcLookupFamInst, tcLookupDataFamInst,
tcGetFamInstEnvs
) where
import HscTypes
import FamInstEnv
import LoadIface
import TypeRep
import TcMType
import TcRnMonad
import TyCon
......@@ -22,6 +25,8 @@ import Maybes
import Control.Monad
import Data.Map (Map)
import qualified Data.Map as Map
#include "HsVersions.h"
\end{code}
......@@ -127,6 +132,90 @@ getFamInsts hpt_fam_insts mod
doc = ppr mod <+> ptext (sLit "is a family-instance module")
\end{code}
%************************************************************************
%* *
Lookup
%* *
%************************************************************************
Look up the instance tycon of a family instance.
The match may be ambiguous (as we know that overlapping instances have
identical right-hand sides under overlapping substitutions - see
'FamInstEnv.lookupFamInstEnvConflicts'). However, the type arguments used
for matching must be equal to or be more specific than those of the family
instance declaration. We pick one of the matches in case of ambiguity; as
the right-hand sides are identical under the match substitution, the choice
does not matter.
Return the instance tycon and its type instance. For example, if we have
tcLookupFamInst 'T' '[Int]' yields (':R42T', 'Int')
then we have a coercion (ie, type instance of family instance coercion)
:Co:R42T Int :: T [Int] ~ :R42T Int
which implies that :R42T was declared as 'data instance T [a]'.
\begin{code}
tcLookupFamInst :: TyCon -> [Type] -> TcM (Maybe (TyCon, [Type]))
tcLookupFamInst tycon tys
| not (isFamilyTyCon tycon)
= return Nothing
| otherwise
= do { instEnv <- tcGetFamInstEnvs
; traceTc "lookupFamInst" ((ppr tycon <+> ppr tys) $$ ppr instEnv)
; case lookupFamInstEnv instEnv tycon tys of
[] -> return Nothing
((fam_inst, rep_tys):_)
-> return $ Just (famInstTyCon fam_inst, rep_tys)
}
tcLookupDataFamInst :: TyCon -> [Type] -> TcM (TyCon, [Type])
-- Find the instance of a data family
-- Note [Looking up family instances for deriving]
tcLookupDataFamInst tycon tys
| not (isFamilyTyCon tycon)
= return (tycon, tys)
| otherwise
= ASSERT( isAlgTyCon tycon )
do { maybeFamInst <- tcLookupFamInst tycon tys
; case maybeFamInst of
Nothing -> famInstNotFound tycon tys
Just famInst -> return famInst }
famInstNotFound :: TyCon -> [Type] -> TcM a
famInstNotFound tycon tys
= failWithTc (ptext (sLit "No family instance for")
<+> quotes (pprTypeApp tycon tys))
\end{code}
Note [Looking up family instances for deriving]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
tcLookupFamInstExact is an auxiliary lookup wrapper which requires
that looked-up family instances exist. If called with a vanilla
tycon, the old type application is simply returned.
If we have
data instance F () = ... deriving Eq
data instance F () = ... deriving Eq
then tcLookupFamInstExact will be confused by the two matches;
but that can't happen because tcInstDecls1 doesn't call tcDeriving
if there are any overlaps.
There are two other things that might go wrong with the lookup.
First, we might see a standalone deriving clause
deriving Eq (F ())
when there is no data instance F () in scope.
Note that it's OK to have
data instance F [a] = ...
deriving Eq (F [(a,b)])
where the match is not exact; the same holds for ordinary data types
with standalone deriving declrations.
%************************************************************************
%* *
Extending the family instance environment
......@@ -178,7 +267,7 @@ Check whether a single family instance conflicts with those in two instance
environments (one for the EPS and one for the HPT).
\begin{code}
checkForConflicts :: (FamInstEnv, FamInstEnv) -> FamInst -> TcM ()
checkForConflicts :: FamInstEnvs -> FamInst -> TcM ()
checkForConflicts inst_envs famInst
= do { -- To instantiate the family instance type, extend the instance
-- envt with completely fresh template variables
......@@ -206,7 +295,7 @@ addFamInstLoc famInst thing_inside
where
loc = getSrcLoc famInst
tcGetFamInstEnvs :: TcM (FamInstEnv, FamInstEnv)
tcGetFamInstEnvs :: TcM FamInstEnvs
-- Gets both the external-package inst-env
-- and the home-pkg inst env (includes module being compiled)
tcGetFamInstEnvs
......
......@@ -15,6 +15,7 @@ import DynFlags
import Generics
import TcRnMonad
import FamInst
import TcEnv
import TcClassDcl( tcAddDeclCtxt ) -- Small helper
import TcGenDeriv -- Deriv stuff
......
......@@ -18,7 +18,6 @@ module TcEnv(
tcLookupField, tcLookupTyCon, tcLookupClass, tcLookupDataCon,
tcLookupLocatedGlobalId, tcLookupLocatedTyCon,
tcLookupLocatedClass,
tcLookupFamInst, tcLookupDataFamInst,
-- Local environment
tcExtendKindEnv, tcExtendKindEnvTvs,
......@@ -66,7 +65,6 @@ import Var
import VarSet
import RdrName
import InstEnv
import FamInstEnv
import DataCon
import TyCon
import TypeRep
......@@ -173,85 +171,8 @@ tcLookupLocatedClass = addLocM tcLookupClass
tcLookupLocatedTyCon :: Located Name -> TcM TyCon
tcLookupLocatedTyCon = addLocM tcLookupTyCon
-- Look up the instance tycon of a family instance.
--
-- The match may be ambiguous (as we know that overlapping instances have
-- identical right-hand sides under overlapping substitutions - see
-- 'FamInstEnv.lookupFamInstEnvConflicts'). However, the type arguments used
-- for matching must be equal to or be more specific than those of the family
-- instance declaration. We pick one of the matches in case of ambiguity; as
-- the right-hand sides are identical under the match substitution, the choice
-- does not matter.
--
-- Return the instance tycon and its type instance. For example, if we have
--
-- tcLookupFamInst 'T' '[Int]' yields (':R42T', 'Int')
--
-- then we have a coercion (ie, type instance of family instance coercion)
--
-- :Co:R42T Int :: T [Int] ~ :R42T Int
--
-- which implies that :R42T was declared as 'data instance T [a]'.
--
tcLookupFamInst :: TyCon -> [Type] -> TcM (Maybe (TyCon, [Type]))
tcLookupFamInst tycon tys
| not (isFamilyTyCon tycon)
= return Nothing
| otherwise
= do { env <- getGblEnv
; eps <- getEps
; let instEnv = (eps_fam_inst_env eps, tcg_fam_inst_env env)
; traceTc "lookupFamInst" ((ppr tycon <+> ppr tys) $$ ppr instEnv)
; case lookupFamInstEnv instEnv tycon tys of
[] -> return Nothing
((fam_inst, rep_tys):_)
-> return $ Just (famInstTyCon fam_inst, rep_tys)
}
tcLookupDataFamInst :: TyCon -> [Type] -> TcM (TyCon, [Type])
-- Find the instance of a data family
-- Note [Looking up family instances for deriving]
tcLookupDataFamInst tycon tys
| not (isFamilyTyCon tycon)
= return (tycon, tys)
| otherwise
= ASSERT( isAlgTyCon tycon )
do { maybeFamInst <- tcLookupFamInst tycon tys
; case maybeFamInst of
Nothing -> famInstNotFound tycon tys
Just famInst -> return famInst }
famInstNotFound :: TyCon -> [Type] -> TcM a
famInstNotFound tycon tys
= failWithTc (ptext (sLit "No family instance for")
<+> quotes (pprTypeApp tycon tys))
\end{code}
Note [Looking up family instances for deriving]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
tcLookupFamInstExact is an auxiliary lookup wrapper which requires
that looked-up family instances exist. If called with a vanilla
tycon, the old type application is simply returned.
If we have
data instance F () = ... deriving Eq
data instance F () = ... deriving Eq
then tcLookupFamInstExact will be confused by the two matches;
but that can't happen because tcInstDecls1 doesn't call tcDeriving
if there are any overlaps.
There are two other things that might go wrong with the lookup.
First, we might see a standalone deriving clause
deriving Eq (F ())
when there is no data instance F () in scope.
Note that it's OK to have
data instance F [a] = ...
deriving Eq (F [(a,b)])
where the match is not exact; the same holds for ordinary data types
with standalone deriving declrations.
\begin{code}
instance MonadThings (IOEnv (Env TcGblEnv TcLclEnv)) where
lookupThing = tcLookupGlobal
......
......@@ -30,6 +30,7 @@ import TcUnify
import BasicTypes
import Inst
import TcBinds
import FamInst( tcLookupFamInst )
import TcEnv
import TcArrows
import TcMatches
......
......@@ -88,7 +88,7 @@ import FamInstEnv
import qualified TcRnMonad as TcM
import qualified TcMType as TcM
import qualified TcEnv as TcM
( checkWellStaged, topIdLvl, tcLookupFamInst, tcGetDefaultTys )
( checkWellStaged, topIdLvl, tcGetDefaultTys )
import Kind
import TcType
import DynFlags
......@@ -957,5 +957,5 @@ matchClass clas tys
}
matchFam :: TyCon -> [Type] -> TcS (Maybe (TyCon, [Type]))
matchFam tycon args = wrapTcS $ TcM.tcLookupFamInst tycon args
matchFam tycon args = wrapTcS $ tcLookupFamInst tycon args
\end{code}
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment