Commit 0fac50a4 authored by Simon Peyton Jones's avatar Simon Peyton Jones

Merge branch 'master' of http://darcs.haskell.org/ghc

parents 570cab3f 95d66964
......@@ -7,10 +7,10 @@
\begin{code}
module DsMonad (
DsM, mapM, mapAndUnzipM,
initDs, initDsTc, fixDs,
foldlM, foldrM, ifDOptM, unsetDOptM, unsetWOptM,
Applicative(..),(<$>),
DsM, mapM, mapAndUnzipM,
initDs, initDsTc, fixDs,
foldlM, foldrM, ifDOptM, unsetDOptM, unsetWOptM,
Applicative(..),(<$>),
newLocalName,
duplicateLocalDs, newSysLocalDs, newSysLocalsDs, newUniqueId,
......@@ -22,18 +22,18 @@ module DsMonad (
UniqSupply, newUniqueSupply,
getDOptsDs, getGhcModeDs, doptDs, woptDs,
dsLookupGlobal, dsLookupGlobalId, dsLookupDPHId, dsLookupTyCon, dsLookupDataCon,
assertDAPPLoaded, lookupDAPPRdrEnv, dsImportDecl, dsImportId, dsImportTyCon,
DsMetaEnv, DsMetaVal(..), dsLookupMetaEnv, dsExtendMetaEnv,
DsMetaEnv, DsMetaVal(..), dsLookupMetaEnv, dsExtendMetaEnv,
dsLoadModule,
-- Warnings
DsWarning, warnDs, failWithDs,
-- Warnings
DsWarning, warnDs, failWithDs,
-- Data types
DsMatchContext(..),
EquationInfo(..), MatchResult(..), DsWrapper, idDsWrapper,
CanItFail(..), orFail
-- Data types
DsMatchContext(..),
EquationInfo(..), MatchResult(..), DsWrapper, idDsWrapper,
CanItFail(..), orFail
) where
import TcRnMonad
......@@ -41,6 +41,8 @@ import CoreSyn
import HsSyn
import TcIface
import LoadIface
import PrelNames
import Avail
import RdrName
import HscTypes
import Bag
......@@ -57,14 +59,16 @@ import NameEnv
import DynFlags
import ErrUtils
import FastString
import Maybes
import Control.Monad
import Data.IORef
\end{code}
%************************************************************************
%* *
Data types for the desugarer
%* *
%* *
Data types for the desugarer
%* *
%************************************************************************
\begin{code}
......@@ -73,8 +77,8 @@ data DsMatchContext
deriving ()
data EquationInfo
= EqnInfo { eqn_pats :: [Pat Id], -- The patterns for an eqn
eqn_rhs :: MatchResult } -- What to do after match
= EqnInfo { eqn_pats :: [Pat Id], -- The patterns for an eqn
eqn_rhs :: MatchResult } -- What to do after match
instance Outputable EquationInfo where
ppr (EqnInfo pats _) = ppr pats
......@@ -84,18 +88,18 @@ idDsWrapper :: DsWrapper
idDsWrapper e = e
-- The semantics of (match vs (EqnInfo wrap pats rhs)) is the MatchResult
-- \fail. wrap (case vs of { pats -> rhs fail })
-- \fail. wrap (case vs of { pats -> rhs fail })
-- where vs are not bound by wrap
-- A MatchResult is an expression with a hole in it
data MatchResult
= MatchResult
CanItFail -- Tells whether the failure expression is used
(CoreExpr -> DsM CoreExpr)
-- Takes a expression to plug in at the
-- failure point(s). The expression should
-- be duplicatable!
CanItFail -- Tells whether the failure expression is used
(CoreExpr -> DsM CoreExpr)
-- Takes a expression to plug in at the
-- failure point(s). The expression should
-- be duplicatable!
data CanItFail = CanFail | CantFail
......@@ -106,14 +110,15 @@ orFail _ _ = CanFail
%************************************************************************
%* *
Monad stuff
%* *
%* *
Monad stuff
%* *
%************************************************************************
Now the mondo monad magic (yes, @DsM@ is a silly name)---carry around
a @UniqueSupply@ and some annotations, which
presumably include source-file location information:
\begin{code}
type DsM result = TcRnIf DsGblEnv DsLclEnv result
......@@ -122,21 +127,24 @@ fixDs :: (a -> DsM a) -> DsM a
fixDs = fixM
type DsWarning = (SrcSpan, SDoc)
-- Not quite the same as a WarnMsg, we have an SDoc here
-- and we'll do the print_unqual stuff later on to turn it
-- into a Doc.
-- Not quite the same as a WarnMsg, we have an SDoc here
-- and we'll do the print_unqual stuff later on to turn it
-- into a Doc.
data DsGblEnv = DsGblEnv {
ds_mod :: Module, -- For SCC profiling
ds_unqual :: PrintUnqualified,
ds_msgs :: IORef Messages, -- Warning messages
ds_if_env :: (IfGblEnv, IfLclEnv) -- Used for looking up global,
-- possibly-imported things
ds_mod :: Module, -- For SCC profiling
ds_unqual :: PrintUnqualified,
ds_msgs :: IORef Messages, -- Warning messages
ds_if_env :: (IfGblEnv, IfLclEnv), -- Used for looking up global,
-- possibly-imported things
ds_dph_env :: GlobalRdrEnv -- exported entities of 'Data.Array.Parallel.Prim' iff
-- '-fdph-*' flag was given (i.e., 'DynFlags.DPHBackend /=
-- DPHNone'); otherwise, empty
}
data DsLclEnv = DsLclEnv {
ds_meta :: DsMetaEnv, -- Template Haskell bindings
ds_loc :: SrcSpan -- to put in pattern-matching error msgs
ds_meta :: DsMetaEnv, -- Template Haskell bindings
ds_loc :: SrcSpan -- to put in pattern-matching error msgs
}
-- Inside [| |] brackets, the desugarer looks
......@@ -144,71 +152,121 @@ data DsLclEnv = DsLclEnv {
type DsMetaEnv = NameEnv DsMetaVal
data DsMetaVal
= Bound Id -- Bound by a pattern inside the [| |].
-- Will be dynamically alpha renamed.
-- The Id has type THSyntax.Var
= Bound Id -- Bound by a pattern inside the [| |].
-- Will be dynamically alpha renamed.
-- The Id has type THSyntax.Var
| Splice (HsExpr Id) -- These bindings are introduced by
-- the PendingSplices on a HsBracketOut
| Splice (HsExpr Id) -- These bindings are introduced by
-- the PendingSplices on a HsBracketOut
initDs :: HscEnv
-> Module -> GlobalRdrEnv -> TypeEnv
-> DsM a
-> IO (Messages, Maybe a)
-> Module -> GlobalRdrEnv -> TypeEnv
-> DsM a
-> IO (Messages, Maybe a)
-- Print errors and warnings, if any arise
initDs hsc_env mod rdr_env type_env thing_inside
= do { msg_var <- newIORef (emptyBag, emptyBag)
; let dflags = hsc_dflags hsc_env
; (ds_gbl_env, ds_lcl_env) <- mkDsEnvs dflags mod rdr_env type_env msg_var
; either_res <- initTcRnIf 'd' hsc_env ds_gbl_env ds_lcl_env $
tryM thing_inside -- Catch exceptions (= errors during desugaring)
-- Display any errors and warnings
-- Note: if -Werror is used, we don't signal an error here.
; msgs <- readIORef msg_var
; let final_res | errorsFound dflags msgs = Nothing
| otherwise = case either_res of
Right res -> Just res
Left exn -> pprPanic "initDs" (text (show exn))
-- The (Left exn) case happens when the thing_inside throws
-- a UserError exception. Then it should have put an error
-- message in msg_var, so we just discard the exception
; return (msgs, final_res) }
= do { msg_var <- newIORef (emptyBag, emptyBag)
; let dflags = hsc_dflags hsc_env
(ds_gbl_env, ds_lcl_env) = mkDsEnvs dflags mod rdr_env type_env msg_var
; either_res <- initTcRnIf 'd' hsc_env ds_gbl_env ds_lcl_env $
loadDAPP dflags $
tryM thing_inside -- Catch exceptions (= errors during desugaring)
-- Display any errors and warnings
-- Note: if -Werror is used, we don't signal an error here.
; msgs <- readIORef msg_var
; let final_res | errorsFound dflags msgs = Nothing
| otherwise = case either_res of
Right res -> Just res
Left exn -> pprPanic "initDs" (text (show exn))
-- The (Left exn) case happens when the thing_inside throws
-- a UserError exception. Then it should have put an error
-- message in msg_var, so we just discard the exception
; return (msgs, final_res)
}
where
-- Extend the global environment with a 'GlobalRdrEnv' containing the exported entities of
-- 'Data.Array.Parallel.Prim' if '-fdph-*' specified.
loadDAPP dflags thing_inside
| Just pkg <- dphPackageMaybe dflags
= do { rdr_env <- loadModule sdoc (dATA_ARRAY_PARALLEL_PRIM pkg)
; updGblEnv (\env -> env {ds_dph_env = rdr_env}) thing_inside
}
| otherwise
= do { ifXOptM Opt_ParallelArrays (liftIO $ fatalErrorMsg dflags $ ptext selectBackendErrPA)
; ifDOptM Opt_Vectorise (liftIO $ fatalErrorMsg dflags $ ptext selectBackendErrVect)
; thing_inside
}
sdoc = ptext (sLit "Internal Data Parallel Haskell interface 'Data.Array.Parallel.Prim'")
selectBackendErrVect = sLit "To use -fvectorise select a DPH backend with -fdph-par or -fdph-seq"
selectBackendErrPA = sLit "To use -XParallelArrays select a DPH backend with -fdph-par or -fdph-seq"
initDsTc :: DsM a -> TcM a
initDsTc thing_inside
= do { this_mod <- getModule
; tcg_env <- getGblEnv
; msg_var <- getErrsVar
= do { this_mod <- getModule
; tcg_env <- getGblEnv
; msg_var <- getErrsVar
; dflags <- getDOpts
; let type_env = tcg_type_env tcg_env
rdr_env = tcg_rdr_env tcg_env
; ds_envs <- liftIO $ mkDsEnvs dflags this_mod rdr_env type_env msg_var
; setEnvs ds_envs thing_inside }
; let type_env = tcg_type_env tcg_env
rdr_env = tcg_rdr_env tcg_env
ds_envs = mkDsEnvs dflags this_mod rdr_env type_env msg_var
; setEnvs ds_envs thing_inside
}
mkDsEnvs :: DynFlags -> Module -> GlobalRdrEnv -> TypeEnv -> IORef Messages -> IO (DsGblEnv, DsLclEnv)
mkDsEnvs :: DynFlags -> Module -> GlobalRdrEnv -> TypeEnv -> IORef Messages -> (DsGblEnv, DsLclEnv)
mkDsEnvs dflags mod rdr_env type_env msg_var
= do -- TODO: unnecessarily monadic
let if_genv = IfGblEnv { if_rec_types = Just (mod, return type_env) }
if_lenv = mkIfLclEnv mod (ptext (sLit "GHC error in desugarer lookup in") <+> ppr mod)
gbl_env = DsGblEnv { ds_mod = mod,
ds_if_env = (if_genv, if_lenv),
ds_unqual = mkPrintUnqualified dflags rdr_env,
ds_msgs = msg_var}
lcl_env = DsLclEnv { ds_meta = emptyNameEnv,
ds_loc = noSrcSpan }
return (gbl_env, lcl_env)
= let if_genv = IfGblEnv { if_rec_types = Just (mod, return type_env) }
if_lenv = mkIfLclEnv mod (ptext (sLit "GHC error in desugarer lookup in") <+> ppr mod)
gbl_env = DsGblEnv { ds_mod = mod
, ds_if_env = (if_genv, if_lenv)
, ds_unqual = mkPrintUnqualified dflags rdr_env
, ds_msgs = msg_var
, ds_dph_env = emptyGlobalRdrEnv
}
lcl_env = DsLclEnv { ds_meta = emptyNameEnv
, ds_loc = noSrcSpan
}
in (gbl_env, lcl_env)
-- Attempt to load the given module and return its exported entities if successful; otherwise, return an
-- empty environment. See "Note [Loading Data.Array.Parallel.Prim]".
--
loadModule :: SDoc -> Module -> DsM GlobalRdrEnv
loadModule doc mod
= do { env <- getGblEnv
; setEnvs (ds_if_env env) $ do
{ iface <- loadInterface doc mod ImportBySystem
; case iface of
Failed _err -> return $ mkGlobalRdrEnv []
Succeeded iface -> return $ mkGlobalRdrEnv . gresFromAvails prov . mi_exports $ iface
} }
where
prov = Imported [ImpSpec { is_decl = imp_spec, is_item = ImpAll }]
imp_spec = ImpDeclSpec { is_mod = name, is_qual = True,
is_dloc = wiredInSrcSpan, is_as = name }
name = moduleName mod
\end{code}
Note [Loading Data.Array.Parallel.Prim]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We generally attempt to load the interface of 'Data.Array.Parallel.Prim' when a DPH backend is selected.
However, while compiling packages containing a DPH backend, we will start out compiling the modules
'Data.Array.Parallel.Prim' depends on — i.e., when compiling these modules, the interface won't exist yet.
This is fine, as these modules do not use the vectoriser, but we need to ensure that GHC doesn't barf when
the interface is missing. Instead of an error message, we just put an empty 'GlobalRdrEnv' into the
'DsM' state.
%************************************************************************
%* *
Operations in the monad
%* *
%* *
Operations in the monad
%* *
%************************************************************************
And all this mysterious stuff is so we can occasionally reach out and
......@@ -223,8 +281,8 @@ newUniqueId id = mkSysLocalM (occNameFS (nameOccName (idName id)))
duplicateLocalDs :: Id -> DsM Id
duplicateLocalDs old_local
= do { uniq <- newUnique
; return (setIdUnique old_local uniq) }
= do { uniq <- newUnique
; return (setIdUnique old_local uniq) }
newPredVarDs :: PredType -> DsM Var
newPredVarDs pred
......@@ -265,18 +323,18 @@ putSrcSpanDs new_loc thing_inside = updLclEnv (\ env -> env {ds_loc = new_loc})
warnDs :: SDoc -> DsM ()
warnDs warn = do { env <- getGblEnv
; loc <- getSrcSpanDs
; let msg = mkWarnMsg loc (ds_unqual env)
(ptext (sLit "Warning:") <+> warn)
; updMutVar (ds_msgs env) (\ (w,e) -> (w `snocBag` msg, e)) }
; loc <- getSrcSpanDs
; let msg = mkWarnMsg loc (ds_unqual env)
(ptext (sLit "Warning:") <+> warn)
; updMutVar (ds_msgs env) (\ (w,e) -> (w `snocBag` msg, e)) }
failWithDs :: SDoc -> DsM a
failWithDs err
= do { env <- getGblEnv
; loc <- getSrcSpanDs
; let msg = mkErrMsg loc (ds_unqual env) err
; updMutVar (ds_msgs env) (\ (w,e) -> (w, e `snocBag` msg))
; failM }
= do { env <- getGblEnv
; loc <- getSrcSpanDs
; let msg = mkErrMsg loc (ds_unqual env) err
; updMutVar (ds_msgs env) (\ (w,e) -> (w, e `snocBag` msg))
; failM }
mkPrintUnqualifiedDs :: DsM PrintUnqualified
mkPrintUnqualifiedDs = ds_unqual <$> getGblEnv
......@@ -289,9 +347,9 @@ instance MonadThings (IOEnv (Env DsGblEnv DsLclEnv)) where
dsLookupGlobal :: Name -> DsM TyThing
-- Very like TcEnv.tcLookupGlobal
dsLookupGlobal name
= do { env <- getGblEnv
; setEnvs (ds_if_env env)
(tcIfaceGlobal name) }
= do { env <- getGblEnv
; setEnvs (ds_if_env env)
(tcIfaceGlobal name) }
dsLookupGlobalId :: Name -> DsM Id
dsLookupGlobalId name
......@@ -319,6 +377,51 @@ dsLookupDataCon name
= tyThingDataCon <$> dsLookupGlobal name
\end{code}
\begin{code}
-- Complain if 'Data.Array.Parallel.Prim' wasn't loaded (and we are about to use it).
--
-- See "Note [Loading Data.Array.Parallel.Prim]".
--
assertDAPPLoaded :: DsM ()
assertDAPPLoaded
= do { env <- ds_dph_env <$> getGblEnv
; when (null $ occEnvElts env) $
panic "'Data.Array.Parallel.Prim' not available; probably missing dependencies in DPH package"
}
-- Look up a name exported by 'Data.Array.Parallel.Prim'.
--
lookupDAPPRdrEnv :: OccName -> DsM Name
lookupDAPPRdrEnv occ
= do { env <- ds_dph_env <$> getGblEnv
; let gres = lookupGlobalRdrEnv env occ
; case gres of
[] -> pprPanic "Name not found in 'Data.Array.Parallel.Prim':" (ppr occ)
[gre] -> return $ gre_name gre
_ -> pprPanic "Multiple definitions in 'Data.Array.Parallel.Prim':" (ppr occ)
}
-- Find the thing repferred to by an imported name.
--
dsImportDecl :: Name -> DsM TyThing
dsImportDecl name
= do { env <- getGblEnv
; setEnvs (ds_if_env env) $ do
{ mb_thing <- importDecl name
; case mb_thing of
Failed err -> failIfM err
Succeeded thing -> return thing
} }
dsImportId :: Name -> DsM Id
dsImportId name
= tyThingId <$> dsImportDecl name
dsImportTyCon :: Name -> DsM TyCon
dsImportTyCon name
= tyThingTyCon <$> dsImportDecl name
\end{code}
\begin{code}
dsLookupMetaEnv :: Name -> DsM (Maybe DsMetaVal)
dsLookupMetaEnv name = do { env <- getLclEnv; return (lookupNameEnv (ds_meta env) name) }
......@@ -327,13 +430,3 @@ dsExtendMetaEnv :: DsMetaEnv -> DsM a -> DsM a
dsExtendMetaEnv menv thing_inside
= updLclEnv (\env -> env { ds_meta = ds_meta env `plusNameEnv` menv }) thing_inside
\end{code}
\begin{code}
dsLoadModule :: SDoc -> Module -> DsM ()
dsLoadModule doc mod
= do { env <- getGblEnv
; setEnvs (ds_if_env env)
(loadSysInterface doc mod >> return ())
}
\end{code}
......@@ -459,7 +459,6 @@ Library
Util
Vectorise.Builtins.Base
Vectorise.Builtins.Initialise
Vectorise.Builtins.Modules
Vectorise.Builtins
Vectorise.Monad.Base
Vectorise.Monad.Naming
......
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
......@@ -494,13 +494,9 @@ tidyInstances tidy_dfun ispecs
\begin{code}
tidyVectInfo :: TidyEnv -> VectInfo -> VectInfo
tidyVectInfo (_, var_env) info@(VectInfo { vectInfoVar = vars
, vectInfoPADFun = pas
, vectInfoIso = isos
, vectInfoScalarVars = scalarVars
})
= info { vectInfoVar = tidy_vars
, vectInfoPADFun = tidy_pas
, vectInfoIso = tidy_isos
, vectInfoScalarVars = tidy_scalarVars
}
where
......@@ -512,11 +508,6 @@ tidyVectInfo (_, var_env) info@(VectInfo { vectInfoVar = vars
, isExportedId tidy_var_v
]
tidy_pas = mapNameEnv tidy_snd_var pas
tidy_isos = mapNameEnv tidy_snd_var isos
tidy_snd_var (x, var) = (x, lookup_var var)
tidy_scalarVars = mkVarSet [ lookup_var var
| var <- varSetElems scalarVars
, isGlobalId var || isExportedId var]
......
......@@ -399,6 +399,9 @@ rANDOM = mkBaseModule (fsLit "System.Random")
gHC_EXTS = mkBaseModule (fsLit "GHC.Exts")
cONTROL_EXCEPTION_BASE = mkBaseModule (fsLit "Control.Exception.Base")
dATA_ARRAY_PARALLEL_PRIM :: PackageId -> Module
dATA_ARRAY_PARALLEL_PRIM pkg = mkModule pkg (mkModuleNameFS (fsLit "Data.Array.Parallel.Prim"))
gHC_PARR :: PackageId -> Module
gHC_PARR pkg = mkModule pkg (mkModuleNameFS (fsLit "Data.Array.Parallel"))
......
......@@ -1485,6 +1485,9 @@ checkValidInstance hs_type tyvars theta clas inst_tys
L loc _ -> loc
\end{code}
Note [Paterson conditions]
~~~~~~~~~~~~~~~~~~~~~~~~~~
Termination test: the so-called "Paterson conditions" (see Section 5 of
"Understanding functionsl dependencies via Constraint Handling Rules,
JFP Jan 2007).
......@@ -1633,7 +1636,6 @@ fvTypes tys = concat (map fvType tys)
-- Size of a type: the number of variables and constructors
sizeType :: Type -> Int
sizeType ty | Just exp_ty <- tcView ty = sizeType exp_ty
sizeType ty | isPredTy ty = sizePred ty
sizeType (TyVarTy _) = 1
sizeType (TyConApp _ tys) = sizeTypes tys + 1
sizeType (FunTy arg res) = sizeType arg + sizeType res + 1
......@@ -1643,18 +1645,41 @@ sizeType (ForAllTy _ ty) = sizeType ty
sizeTypes :: [Type] -> Int
sizeTypes xs = sum (map sizeType xs)
-- Size of a predicate
-- Size of a predicate: the number of variables and constructors
--
-- Note [Paterson conditions on PredTypes]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--
-- We are considering whether *class* constraints terminate
-- Once we get into an implicit parameter or equality we
-- can't get back to a class constraint, so it's safe
-- to say "size 0". See Trac #4200.
-- (see Note [Paterson conditions]). Precisely, the Paterson conditions
-- would have us check that "the constraint has fewer constructors and variables
-- (taken together and counting repetitions) than the head.".
--
-- However, we can be a bit more refined by looking at which kind of constraint
-- this actually is. There are two main tricks:
--
-- 1. It seems like it should be OK not to count the tuple type constructor
-- for a PredType like (Show a, Eq a) :: Constraint, since we don't
-- count the "implicit" tuple in the ThetaType itself.
--
-- In fact, the Paterson test just checks *each component* of the top level
-- ThetaType against the size bound, one at a time. By analogy, it should be
-- OK to return the size of the *largest* tuple component as the size of the
-- whole tuple.
--
-- 2. Once we get into an implicit parameter or equality we
-- can't get back to a class constraint, so it's safe
-- to say "size 0". See Trac #4200.
--
-- NB: we don't want to detect PredTypes in sizeType (and then call
-- sizePred on them), or we might get an infinite loop if that PredType
-- is irreducible. See Trac #5581.
sizePred :: PredType -> Int
sizePred ty = go (predTypePredTree ty)
where
go (ClassPred _ tys') = sizeTypes tys'
go (IPPred {}) = 0
go (EqPred {}) = 0
go (TuplePred ts) = sum (map go ts)
go (TuplePred ts) = maximum (0:map go ts)
go (IrredPred ty) = sizeType ty
\end{code}
-- Types and functions declared in the DPH packages and used by the vectoriser.
-- Types and functions declared in 'Data.Array.Parallel.Prim' and used by the vectoriser.
--
-- The @Builtins@ structure holds the name of all the things in the DPH packages that appear in
-- code generated by the vectoriser. We can get specific things using the selectors, which print a
-- civilized panic message if the specified thing cannot be found.
-- The @Builtins@ structure holds the name of all the things in 'Data.Array.Parallel.Prim' that appear in
-- code generated by the vectoriser.
module Vectorise.Builtins (
-- * Builtins
Builtins(..),
indexBuiltin,
-- * Wrapped selectors
parray_PrimTyCon,
selTy,
selReplicate,
selPick,
selTags,
selElements,
sumTyCon,
prodTyCon,
prodDataCon,
replicatePD_PrimVar,
emptyPD_PrimVar,
packByTagPD_PrimVar,
combinePDVar,
combinePD_PrimVar,
scalarZip,
closureCtrFun,
-- * Initialisation
initBuiltins, initBuiltinVars, initBuiltinTyCons,
initBuiltinPAs, initBuiltinPRs,
-- * Lookup
primMethod,
primPArray
initBuiltins, initBuiltinVars, initBuiltinTyCons
) where
import Vectorise.Builtins.Base
import Vectorise.Builtins.Modules
import Vectorise.Builtins.Initialise
import TysPrim
import IfaceEnv
import TyCon
import DsMonad
import NameEnv
import Name
import Var
import Control.Monad
-- |Lookup a method function given its name and instance type.
--
primMethod :: TyCon -> String -> Builtins -> DsM (Maybe Var)
primMethod tycon method (Builtins { dphModules = mods })
| Just suffix <- lookupNameEnv prim_ty_cons (tyConName tycon)
= liftM Just
$ dsLookupGlobalId =<< lookupOrig (dph_Unboxed mods)
(mkVarOcc $ method ++ suffix)
| otherwise = return Nothing
-- |Lookup the representation type we use for PArrays that contain a given element type.
--
primPArray :: TyCon -> Builtins -> DsM (Maybe TyCon)
primPArray tycon (Builtins { dphModules = mods })
| Just suffix <- lookupNameEnv prim_ty_cons (tyConName tycon)
= liftM Just
$ dsLookupTyCon =<< lookupOrig (dph_Unboxed mods)
(mkTcOcc $ "PArray" ++ suffix)