Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/c2214c9dbae8ba3432c49ef875b28e4755b3cca7 >--------------------------------------------------------------- commit c2214c9dbae8ba3432c49ef875b28e4755b3cca7 Author: Manuel M T Chakravarty <[email protected]> Date: Mon Nov 14 12:15:37 2011 +1100 Maintain the mapping of class selectors in 'VectInfo' >--------------------------------------------------------------- compiler/iface/TcIface.lhs | 10 +++++----- compiler/vectorise/Vectorise/Env.hs | 33 ++++++++++++++++++++++----------- 2 files changed, 27 insertions(+), 16 deletions(-) diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs index 4007cd5..d17b90d 100644 --- a/compiler/iface/TcIface.lhs +++ b/compiler/iface/TcIface.lhs @@ -713,11 +713,11 @@ tcIfaceAnnTarget (ModuleTarget mod) = do \begin{code} -- We need access to the type environment as we need to look up information about type constructors --- (i.e., their data constructors and whether they are class type constructors) and about classes --- (i.e., their selector ids). If a vectorised type constructor or class is defined in the same --- module as where it is vectorised, we cannot look that information up from the type constructor --- that we obtained via a 'forkM'ed 'tcIfaceTyCon' without recursively loading the interface that --- we are already type checking again and again and again... +-- (i.e., their data constructors and whether they are class type constructors). If a vectorised +-- type constructor or class is defined in the same module as where it is vectorised, we cannot +-- look that information up from the type constructor that we obtained via a 'forkM'ed +-- 'tcIfaceTyCon' without recursively loading the interface that we are already type checking again +-- and again and again... -- tcIfaceVectInfo :: Module -> TypeEnv -> IfaceVectInfo -> IfL VectInfo tcIfaceVectInfo mod typeEnv (IfaceVectInfo diff --git a/compiler/vectorise/Vectorise/Env.hs b/compiler/vectorise/Vectorise/Env.hs index 2de71a5..ccf034b 100644 --- a/compiler/vectorise/Vectorise/Env.hs +++ b/compiler/vectorise/Vectorise/Env.hs @@ -21,6 +21,7 @@ import InstEnv import FamInstEnv import CoreSyn import Type +import Class import TyCon import DataCon import VarEnv @@ -31,15 +32,20 @@ import Name import NameEnv import FastString +import Data.Maybe --- | Indicates what scope something (a variable) is in. + +-- |Indicates what scope something (a variable) is in. +-- data Scope a b = Global a | Local b -- LocalEnv ------------------------------------------------------------------- --- | The local environment. + +-- |The local environment. +-- data LocalEnv = LocalEnv { -- Mapping from local variables to their vectorised and lifted versions. @@ -55,8 +61,8 @@ data LocalEnv , local_bind_name :: FastString } - --- | Create an empty local environment. +-- |Create an empty local environment. +-- emptyLocalEnv :: LocalEnv emptyLocalEnv = LocalEnv { local_vars = emptyVarEnv @@ -188,6 +194,8 @@ setPRFunsEnv ps genv = genv { global_pr_funs = mkNameEnv ps } -- data constructors referenced in VECTORISE pragmas, even if they are defined in an imported -- module. -- +-- The variables explicitly include class selectors. +-- modVectInfo :: GlobalEnv -> [Id] -> [TyCon] -> [CoreVect]-> VectInfo -> VectInfo modVectInfo env mg_ids mg_tyCons vectDecls info = info @@ -198,13 +206,16 @@ modVectInfo env mg_ids mg_tyCons vectDecls info , vectInfoScalarTyCons = global_scalar_tycons env `minusNameSet` vectInfoScalarTyCons info } where - vectIds = [id | Vect id _ <- vectDecls] - vectTypeTyCons = [tycon | VectType _ tycon _ <- vectDecls] ++ - [tycon | VectClass tycon <- vectDecls] - vectDataCons = concatMap tyConDataCons vectTypeTyCons - ids = mg_ids ++ vectIds - tyCons = mg_tyCons ++ vectTypeTyCons - dataCons = concatMap tyConDataCons mg_tyCons ++ vectDataCons + vectIds = [id | Vect id _ <- vectDecls] + vectTypeTyCons = [tycon | VectType _ tycon _ <- vectDecls] ++ + [tycon | VectClass tycon <- vectDecls] + vectDataCons = concatMap tyConDataCons vectTypeTyCons + ids = mg_ids ++ vectIds ++ selIds + tyCons = mg_tyCons ++ vectTypeTyCons + dataCons = concatMap tyConDataCons mg_tyCons ++ vectDataCons + selIds = concat [ classAllSelIds cls + | tycon <- tyCons + , cls <- maybeToList . tyConClass_maybe $ tycon] -- Produce an entry for every declaration that is mentioned in the domain of the 'inspectedEnv' mk_env decls inspectedEnv _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
