return (ModuleTarget a)
instance Binary IfaceVectInfo where
- put_ bh (IfaceVectInfo a1 a2 a3) = do
+ put_ bh (IfaceVectInfo a1 a2 a3 a4 a5) = do
put_ bh a1
put_ bh a2
put_ bh a3
+ put_ bh a4
+ put_ bh a5
get bh = do
a1 <- get bh
a2 <- get bh
a3 <- get bh
- return (IfaceVectInfo a1 a2 a3)
+ a4 <- get bh
+ a5 <- get bh
+ return (IfaceVectInfo a1 a2 a3 a4 a5)
pprFix (occ,fix) = ppr fix <+> ppr occ
pprVectInfo :: IfaceVectInfo -> SDoc
-pprVectInfo (IfaceVectInfo { ifaceVectInfoVar = vars
- , ifaceVectInfoTyCon = tycons
- , ifaceVectInfoTyConReuse = tyconsReuse
+pprVectInfo (IfaceVectInfo { ifaceVectInfoVar = vars
+ , ifaceVectInfoTyCon = tycons
+ , ifaceVectInfoTyConReuse = tyconsReuse
+ , ifaceVectInfoScalarVars = scalarVars
+ , ifaceVectInfoScalarTyCons = scalarTyCons
}) =
vcat
[ ptext (sLit "vectorised variables:") <+> hsep (map ppr vars)
, ptext (sLit "vectorised tycons:") <+> hsep (map ppr tycons)
, ptext (sLit "vectorised reused tycons:") <+> hsep (map ppr tyconsReuse)
+ , ptext (sLit "scalar variables:") <+> hsep (map ppr scalarVars)
+ , ptext (sLit "scalar tycons:") <+> hsep (map ppr scalarTyCons)
]
instance Outputable Warnings where
module MkIface (
mkUsedNames,
mkDependencies,
- mkIface, -- Build a ModIface from a ModGuts,
- -- including computing version information
+ mkIface, -- Build a ModIface from a ModGuts,
+ -- including computing version information
mkIfaceTc,
- writeIfaceFile, -- Write the interface file
+ writeIfaceFile, -- Write the interface file
- checkOldIface, -- See if recompilation is required, by
- -- comparing version information
+ checkOldIface, -- See if recompilation is required, by
+ -- comparing version information
tyThingToIfaceDecl -- Converting things to their Iface equivalents
) where
\end{code}
- -----------------------------------------------
- Recompilation checking
- -----------------------------------------------
+ -----------------------------------------------
+ Recompilation checking
+ -----------------------------------------------
A complete description of how recompilation checking works can be
found in the wiki commentary:
import Finder
import DynFlags
import VarEnv
+import VarSet
import Var
import Name
import RdrName
ifFamInstTcName = ifaceTyConName . ifFamInstTyCon
- flattenVectInfo (VectInfo { vectInfoVar = vVar
- , vectInfoTyCon = vTyCon
+ flattenVectInfo (VectInfo { vectInfoVar = vVar
+ , vectInfoTyCon = vTyCon
+ , vectInfoScalarVars = vScalarVars
+ , vectInfoScalarTyCons = vScalarTyCons
}) =
- IfaceVectInfo {
- ifaceVectInfoVar = [ Var.varName v
- | (v, _) <- varEnvElts vVar],
- ifaceVectInfoTyCon = [ tyConName t
- | (t, t_v) <- nameEnvElts vTyCon
- , t /= t_v],
- ifaceVectInfoTyConReuse = [ tyConName t
- | (t, t_v) <- nameEnvElts vTyCon
- , t == t_v]
+ IfaceVectInfo
+ { ifaceVectInfoVar = [Var.varName v | (v, _ ) <- varEnvElts vVar]
+ , ifaceVectInfoTyCon = [tyConName t | (t, t_v) <- nameEnvElts vTyCon, t /= t_v]
+ , ifaceVectInfoTyConReuse = [tyConName t | (t, t_v) <- nameEnvElts vTyCon, t == t_v]
+ , ifaceVectInfoScalarVars = [Var.varName v | v <- varSetElems vScalarVars]
+ , ifaceVectInfoScalarTyCons = nameSetToList vScalarTyCons
}
-----------------------------
import TyCon
import DataCon
import TysWiredIn
-import TysPrim ( anyTyConOfKind )
-import BasicTypes ( Arity, nonRuleLoopBreaker )
+import TysPrim ( anyTyConOfKind )
+import BasicTypes ( Arity, nonRuleLoopBreaker )
import qualified Var
import VarEnv
+import VarSet
import Name
import NameEnv
-import OccurAnal ( occurAnalyseExpr )
-import Demand ( isBottomingSig )
+import NameSet
+import OccurAnal ( occurAnalyseExpr )
+import Demand ( isBottomingSig )
import Module
import UniqFM
import UniqSupply
%************************************************************************
-%* *
- Vectorisation information
-%* *
+%* *
+ Vectorisation information
+%* *
%************************************************************************
\begin{code}
tcIfaceVectInfo :: Module -> TypeEnv -> IfaceVectInfo -> IfL VectInfo
tcIfaceVectInfo mod typeEnv (IfaceVectInfo
- { ifaceVectInfoVar = vars
- , ifaceVectInfoTyCon = tycons
- , ifaceVectInfoTyConReuse = tyconsReuse
+ { ifaceVectInfoVar = vars
+ , ifaceVectInfoTyCon = tycons
+ , ifaceVectInfoTyConReuse = tyconsReuse
+ , ifaceVectInfoScalarVars = scalarVars
+ , ifaceVectInfoScalarTyCons = scalarTyCons
})
= do { vVars <- mapM vectVarMapping vars
; tyConRes1 <- mapM vectTyConMapping tycons
; tyConRes2 <- mapM vectTyConReuseMapping tyconsReuse
; let (vTyCons, vDataCons, vPAs, vIsos) = unzip4 (tyConRes1 ++ tyConRes2)
; return $ VectInfo
- { vectInfoVar = mkVarEnv vVars
- , vectInfoTyCon = mkNameEnv vTyCons
- , vectInfoDataCon = mkNameEnv (concat vDataCons)
- , vectInfoPADFun = mkNameEnv vPAs
- , vectInfoIso = mkNameEnv vIsos
+ { vectInfoVar = mkVarEnv vVars
+ , vectInfoTyCon = mkNameEnv vTyCons
+ , vectInfoDataCon = mkNameEnv (concat vDataCons)
+ , vectInfoPADFun = mkNameEnv vPAs
+ , vectInfoIso = mkNameEnv vIsos
+ , vectInfoScalarVars = mkVarSet (map lookupVar scalarVars)
+ , vectInfoScalarTyCons = mkNameSet scalarTyCons
}
}
where
\end{code}
%************************************************************************
-%* *
- Types
-%* *
+%* *
+ Types
+%* *
%************************************************************************
\begin{code}
#include "HsVersions.h"
#ifdef GHCI
-import ByteCodeAsm ( CompiledByteCode )
+import ByteCodeAsm ( CompiledByteCode )
import {-# SOURCE #-} InteractiveEval ( Resume )
#endif
import RdrName
import Name
import NameEnv
-import NameSet
+import NameSet
import Module
-import InstEnv ( InstEnv, Instance )
-import FamInstEnv ( FamInstEnv, FamInst )
-import Rules ( RuleBase )
-import CoreSyn ( CoreBind )
+import InstEnv ( InstEnv, Instance )
+import FamInstEnv ( FamInstEnv, FamInst )
+import Rules ( RuleBase )
+import CoreSyn ( CoreBind )
import VarEnv
+import VarSet
import Var
import Id
-import Type
+import Type
import Annotations
import Class ( Class, classAllSelIds, classATs, classTyCon )
\end{code}
%************************************************************************
-%* *
+%* *
\subsection{Vectorisation Support}
-%* *
+%* *
%************************************************************************
The following information is generated and consumed by the vectorisation
on just the OccName easily in a Core pass.
\begin{code}
--- | Vectorisation information for 'ModGuts', 'ModDetails' and 'ExternalPackageState'.
+-- |Vectorisation information for 'ModGuts', 'ModDetails' and 'ExternalPackageState'; see also
+-- documentation at 'Vectorise.Env.GlobalEnv'.
data VectInfo
- = VectInfo {
- vectInfoVar :: VarEnv (Var , Var ), -- ^ @(f, f_v)@ keyed on @f@
- vectInfoTyCon :: NameEnv (TyCon , TyCon), -- ^ @(T, T_v)@ keyed on @T@
- vectInfoDataCon :: NameEnv (DataCon, DataCon), -- ^ @(C, C_v)@ keyed on @C@
- vectInfoPADFun :: NameEnv (TyCon , Var), -- ^ @(T_v, paT)@ keyed on @T_v@
- vectInfoIso :: NameEnv (TyCon , Var) -- ^ @(T, isoT)@ keyed on @T@
+ = VectInfo
+ { vectInfoVar :: VarEnv (Var , Var ) -- ^ @(f, f_v)@ keyed on @f@
+ , vectInfoTyCon :: NameEnv (TyCon , TyCon) -- ^ @(T, T_v)@ keyed on @T@
+ , vectInfoDataCon :: NameEnv (DataCon, DataCon) -- ^ @(C, C_v)@ keyed on @C@
+ , vectInfoPADFun :: NameEnv (TyCon , Var) -- ^ @(T_v, paT)@ keyed on @T_v@
+ , vectInfoIso :: NameEnv (TyCon , Var) -- ^ @(T, isoT)@ keyed on @T@
+ , vectInfoScalarVars :: VarSet -- ^ set of purely scalar variables
+ , vectInfoScalarTyCons :: NameSet -- ^ set of scalar type constructors
}
--- | Vectorisation information for 'ModIface': a slightly less low-level view
+-- |Vectorisation information for 'ModIface'; i.e, the vectorisation information propagated
+-- across module boundaries.
+--
data IfaceVectInfo
- = IfaceVectInfo {
- ifaceVectInfoVar :: [Name],
- -- ^ All variables in here have a vectorised variant
- ifaceVectInfoTyCon :: [Name],
- -- ^ All 'TyCon's in here have a vectorised variant;
- -- the name of the vectorised variant and those of its
- -- data constructors are determined by 'OccName.mkVectTyConOcc'
- -- and 'OccName.mkVectDataConOcc'; the names of
- -- the isomorphisms are determined by 'OccName.mkVectIsoOcc'
- ifaceVectInfoTyConReuse :: [Name]
- -- ^ The vectorised form of all the 'TyCon's in here coincides with
- -- the unconverted form; the name of the isomorphisms is determined
- -- by 'OccName.mkVectIsoOcc'
+ = IfaceVectInfo
+ { ifaceVectInfoVar :: [Name] -- ^ All variables in here have a vectorised variant
+ , ifaceVectInfoTyCon :: [Name] -- ^ All 'TyCon's in here have a vectorised variant;
+ -- the name of the vectorised variant and those of its
+ -- data constructors are determined by
+ -- 'OccName.mkVectTyConOcc' and
+ -- 'OccName.mkVectDataConOcc'; the names of the
+ -- isomorphisms are determined by 'OccName.mkVectIsoOcc'
+ , ifaceVectInfoTyConReuse :: [Name] -- ^ The vectorised form of all the 'TyCon's in here
+ -- coincides with the unconverted form; the name of the
+ -- isomorphisms is determined by 'OccName.mkVectIsoOcc'
+ , ifaceVectInfoScalarVars :: [Name] -- iface version of 'vectInfoScalarVar'
+ , ifaceVectInfoScalarTyCons :: [Name] -- iface version of 'vectInfoScalarTyCon'
}
noVectInfo :: VectInfo
-noVectInfo = VectInfo emptyVarEnv emptyNameEnv emptyNameEnv emptyNameEnv emptyNameEnv
+noVectInfo
+ = VectInfo emptyVarEnv emptyNameEnv emptyNameEnv emptyNameEnv emptyNameEnv emptyVarSet
+ emptyNameSet
plusVectInfo :: VectInfo -> VectInfo -> VectInfo
plusVectInfo vi1 vi2 =
- VectInfo (vectInfoVar vi1 `plusVarEnv` vectInfoVar vi2)
- (vectInfoTyCon vi1 `plusNameEnv` vectInfoTyCon vi2)
- (vectInfoDataCon vi1 `plusNameEnv` vectInfoDataCon vi2)
- (vectInfoPADFun vi1 `plusNameEnv` vectInfoPADFun vi2)
- (vectInfoIso vi1 `plusNameEnv` vectInfoIso vi2)
+ VectInfo (vectInfoVar vi1 `plusVarEnv` vectInfoVar vi2)
+ (vectInfoTyCon vi1 `plusNameEnv` vectInfoTyCon vi2)
+ (vectInfoDataCon vi1 `plusNameEnv` vectInfoDataCon vi2)
+ (vectInfoPADFun vi1 `plusNameEnv` vectInfoPADFun vi2)
+ (vectInfoIso vi1 `plusNameEnv` vectInfoIso vi2)
+ (vectInfoScalarVars vi1 `unionVarSet` vectInfoScalarVars vi2)
+ (vectInfoScalarTyCons vi1 `unionNameSets` vectInfoScalarTyCons vi2)
concatVectInfo :: [VectInfo] -> VectInfo
concatVectInfo = foldr plusVectInfo noVectInfo
noIfaceVectInfo :: IfaceVectInfo
-noIfaceVectInfo = IfaceVectInfo [] [] []
+noIfaceVectInfo = IfaceVectInfo [] [] [] [] []
\end{code}
%************************************************************************
\begin{code}
tidyVectInfo :: TidyEnv -> VectInfo -> VectInfo
-tidyVectInfo (_, var_env) info@(VectInfo { vectInfoVar = vars
- , vectInfoPADFun = pas
- , vectInfoIso = isos })
- = info { vectInfoVar = tidy_vars
- , vectInfoPADFun = tidy_pas
- , vectInfoIso = tidy_isos }
+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
tidy_vars = mkVarEnv
$ map tidy_var_mapping
tidy_var_mapping (from, to) = (from', (from', lookup_var to))
where from' = lookup_var from
tidy_snd_var (x, var) = (x, lookup_var var)
+
+ tidy_scalarVars = mkVarSet
+ $ map lookup_var
+ $ varSetElems scalarVars
lookup_var var = lookupWithDefaultVarEnv var_env var var
\end{code}
module Vectorise.Env (
- Scope(..),
-
- -- * Local Environments
- LocalEnv(..),
- emptyLocalEnv,
-
- -- * Global Environments
- GlobalEnv(..),
- initGlobalEnv,
- extendImportedVarsEnv,
- extendScalars,
- setFamEnv,
- extendFamEnv,
- extendTyConsEnv,
- extendDataConsEnv,
- extendPAFunsEnv,
- setPRFunsEnv,
- setBoxedTyConsEnv,
- updVectInfo
+ Scope(..),
+
+ -- * Local Environments
+ LocalEnv(..),
+ emptyLocalEnv,
+
+ -- * Global Environments
+ GlobalEnv(..),
+ initGlobalEnv,
+ extendImportedVarsEnv,
+ extendScalars,
+ setFamEnv,
+ extendFamEnv,
+ extendTyConsEnv,
+ extendDataConsEnv,
+ extendPAFunsEnv,
+ setPRFunsEnv,
+ setBoxedTyConsEnv,
+ modVectInfo
) where
import HscTypes
import VarEnv
import VarSet
import Var
+import NameSet
import Name
import NameEnv
import FastString
-- | Indicates what scope something (a variable) is in.
data Scope a b
- = Global a
- | Local b
+ = Global a
+ | Local b
-- LocalEnv -------------------------------------------------------------------
-- GlobalEnv ------------------------------------------------------------------
--- | The global environment.
--- These are things the exist at top-level.
+
+-- |The global environment: entities that exist at top-level.
+--
data GlobalEnv
- = GlobalEnv {
- -- | Mapping from global variables to their vectorised versions — aka the /vectorisation
- -- map/.
- global_vars :: VarEnv Var
-
- -- | Mapping from global variables that have a vectorisation declaration to the right-hand
- -- side of that declaration and its type. This mapping only applies to non-scalar
- -- vectorisation declarations. All variables with a scalar vectorisation declaration are
- -- mentioned in 'global_scalars'.
+ = GlobalEnv
+ -- |Mapping from global variables to their vectorised versions — aka the /vectorisation
+ -- map/.
+ { global_vars :: VarEnv Var
+
+ -- |Mapping from global variables that have a vectorisation declaration to the right-hand
+ -- side of that declaration and its type. This mapping only applies to non-scalar
+ -- vectorisation declarations. All variables with a scalar vectorisation declaration are
+ -- mentioned in 'global_scalars_vars'.
, global_vect_decls :: VarEnv (Type, CoreExpr)
- -- | Purely scalar variables. Code which mentions only these variables doesn't have to be
- -- lifted. This includes variables from the current module that have a scalar
- -- vectorisation declaration and those that the vectoriser determines to be scalar.
- , global_scalars :: VarSet
+ -- |Purely scalar variables. Code which mentions only these variables doesn't have to be
+ -- lifted. This includes variables from the current module that have a scalar
+ -- vectorisation declaration and those that the vectoriser determines to be scalar.
+ , global_scalar_vars :: VarSet
+
+ -- |Type constructors whose values can only contain scalar data. Scalar code may only
+ -- operate on such data.
+ , global_scalar_tycons :: NameSet
- -- | Exported variables which have a vectorised version.
- , global_exported_vars :: VarEnv (Var, Var)
+ -- |Exported variables which have a vectorised version.
+ , global_exported_vars :: VarEnv (Var, Var)
- -- | Mapping from TyCons to their vectorised versions.
- -- TyCons which do not have to be vectorised are mapped to themselves.
- , global_tycons :: NameEnv TyCon
+ -- |Mapping from TyCons to their vectorised versions.
+ -- TyCons which do not have to be vectorised are mapped to themselves.
+ , global_tycons :: NameEnv TyCon
- -- | Mapping from DataCons to their vectorised versions.
+ -- |Mapping from DataCons to their vectorised versions.
, global_datacons :: NameEnv DataCon
- -- | Mapping from TyCons to their PA dfuns.
+ -- |Mapping from TyCons to their PA dfuns.
, global_pa_funs :: NameEnv Var
- -- | Mapping from TyCons to their PR dfuns.
- , global_pr_funs :: NameEnv Var
+ -- |Mapping from TyCons to their PR dfuns.
+ , global_pr_funs :: NameEnv Var
- -- | Mapping from unboxed TyCons to their boxed versions.
- , global_boxed_tycons :: NameEnv TyCon
+ -- |Mapping from unboxed TyCons to their boxed versions.
+ , global_boxed_tycons :: NameEnv TyCon
- -- | External package inst-env & home-package inst-env for class instances.
- , global_inst_env :: (InstEnv, InstEnv)
+ -- |External package inst-env & home-package inst-env for class instances.
+ , global_inst_env :: (InstEnv, InstEnv)
- -- | External package inst-env & home-package inst-env for family instances.
- , global_fam_inst_env :: FamInstEnvs
+ -- |External package inst-env & home-package inst-env for family instances.
+ , global_fam_inst_env :: FamInstEnvs
- -- | Hoisted bindings.
- , global_bindings :: [(Var, CoreExpr)]
+ -- |Hoisted bindings.
+ , global_bindings :: [(Var, CoreExpr)]
}
--- | Create an initial global environment
+-- |Create an initial global environment.
+--
initGlobalEnv :: VectInfo -> [CoreVect] -> (InstEnv, InstEnv) -> FamInstEnvs -> GlobalEnv
initGlobalEnv info vectDecls instEnvs famInstEnvs
= GlobalEnv
{ global_vars = mapVarEnv snd $ vectInfoVar info
, global_vect_decls = mkVarEnv vects
- , global_scalars = mkVarSet scalars
+ , global_scalar_vars = vectInfoScalarVars info `extendVarSetList` scalars
+ , global_scalar_tycons = vectInfoScalarTyCons info
, global_exported_vars = emptyVarEnv
, global_tycons = mapNameEnv snd $ vectInfoTyCon info
, global_datacons = mapNameEnv snd $ vectInfoDataCon info
-- Operators on Global Environments -------------------------------------------
--- | Extend the list of global variables in an environment.
+
+-- |Extend the list of global variables in an environment.
+--
extendImportedVarsEnv :: [(Var, Var)] -> GlobalEnv -> GlobalEnv
extendImportedVarsEnv ps genv
- = genv { global_vars = extendVarEnvList (global_vars genv) ps }
+ = genv { global_vars = extendVarEnvList (global_vars genv) ps }
--- | Extend the set of scalar variables in an environment.
+-- |Extend the set of scalar variables in an environment.
+--
extendScalars :: [Var] -> GlobalEnv -> GlobalEnv
extendScalars vs genv
- = genv { global_scalars = extendVarSetList (global_scalars genv) vs }
+ = genv { global_scalar_vars = extendVarSetList (global_scalar_vars genv) vs }
--- | Set the list of type family instances in an environment.
+-- |Set the list of type family instances in an environment.
+--
setFamEnv :: FamInstEnv -> GlobalEnv -> GlobalEnv
setFamEnv l_fam_inst genv
= genv { global_fam_inst_env = (g_fam_inst, l_fam_inst) }
where (g_fam_inst, _) = global_fam_inst_env genv
+-- |Extend the list of type family instances.
+--
extendFamEnv :: [FamInst] -> GlobalEnv -> GlobalEnv
extendFamEnv new genv
= genv { global_fam_inst_env = (g_fam_inst, extendFamInstEnvList l_fam_inst new) }
where (g_fam_inst, l_fam_inst) = global_fam_inst_env genv
-
--- | Extend the list of type constructors in an environment.
+-- |Extend the list of type constructors in an environment.
+--
extendTyConsEnv :: [(Name, TyCon)] -> GlobalEnv -> GlobalEnv
extendTyConsEnv ps genv
= genv { global_tycons = extendNameEnvList (global_tycons genv) ps }
-
--- | Extend the list of data constructors in an environment.
+-- |Extend the list of data constructors in an environment.
+--
extendDataConsEnv :: [(Name, DataCon)] -> GlobalEnv -> GlobalEnv
extendDataConsEnv ps genv
= genv { global_datacons = extendNameEnvList (global_datacons genv) ps }
-
--- | Extend the list of PA functions in an environment.
+-- |Extend the list of PA functions in an environment.
+--
extendPAFunsEnv :: [(Name, Var)] -> GlobalEnv -> GlobalEnv
extendPAFunsEnv ps genv
= genv { global_pa_funs = extendNameEnvList (global_pa_funs genv) ps }
-
--- | Set the list of PR functions in an environment.
+-- |Set the list of PR functions in an environment.
+--
setPRFunsEnv :: [(Name, Var)] -> GlobalEnv -> GlobalEnv
setPRFunsEnv ps genv
= genv { global_pr_funs = mkNameEnv ps }
-
--- | Set the list of boxed type constructor in an environment.
+-- |Set the list of boxed type constructor in an environment.
+--
setBoxedTyConsEnv :: [(Name, TyCon)] -> GlobalEnv -> GlobalEnv
setBoxedTyConsEnv ps genv
= genv { global_boxed_tycons = mkNameEnv ps }
-
--- | TODO: What is this for?
-updVectInfo :: GlobalEnv -> TypeEnv -> VectInfo -> VectInfo
-updVectInfo env tyenv info
+-- |Compute vectorisation information that goes into 'ModGuts' (and is stored in interface files).
+-- The incoming 'vectInfo' is that from the 'HscEnv' and 'EPS'. The outgoing one contains only the
+-- definitions for the currently compiled module.
+--
+modVectInfo :: GlobalEnv -> TypeEnv -> VectInfo -> VectInfo
+modVectInfo env tyenv info
= info
- { vectInfoVar = global_exported_vars env
- , vectInfoTyCon = mk_env typeEnvTyCons global_tycons
- , vectInfoDataCon = mk_env typeEnvDataCons global_datacons
- , vectInfoPADFun = mk_env typeEnvTyCons global_pa_funs
+ { vectInfoVar = global_exported_vars env
+ , vectInfoTyCon = mk_env typeEnvTyCons global_tycons
+ , vectInfoDataCon = mk_env typeEnvDataCons global_datacons
+ , vectInfoPADFun = mk_env typeEnvTyCons global_pa_funs
+ , vectInfoScalarVars = global_scalar_vars env `minusVarSet` vectInfoScalarVars info
+ , vectInfoScalarTyCons = global_scalar_tycons env `minusNameSet` vectInfoScalarTyCons info
}
where
mk_env from_tyenv from_env
- = mkNameEnv [(name, (from,to))
- | from <- from_tyenv tyenv
- , let name = getName from
- , Just to <- [lookupNameEnv (from_env env) name]]
-
+ = mkNameEnv [(name, (from,to))
+ | from <- from_tyenv tyenv
+ , let name = getName from
+ , Just to <- [lookupNameEnv (from_env env) name]]
module Vectorise.Monad (
- module Vectorise.Monad.Base,
- module Vectorise.Monad.Naming,
- module Vectorise.Monad.Local,
- module Vectorise.Monad.Global,
- module Vectorise.Monad.InstEnv,
- initV,
-
- -- * Builtins
- liftBuiltinDs,
- builtin,
- builtins,
-
- -- * Variables
- lookupVar,
- maybeCantVectoriseVarM,
- dumpVar,
- addGlobalScalar,
- deleteGlobalScalar,
+ module Vectorise.Monad.Base,
+ module Vectorise.Monad.Naming,
+ module Vectorise.Monad.Local,
+ module Vectorise.Monad.Global,
+ module Vectorise.Monad.InstEnv,
+ initV,
+
+ -- * Builtins
+ liftBuiltinDs,
+ builtin,
+ builtins,
+
+ -- * Variables
+ lookupVar,
+ maybeCantVectoriseVarM,
+ dumpVar,
+ addGlobalScalar,
- -- * Primitives
- lookupPrimPArray,
- lookupPrimMethod
+ -- * Primitives
+ lookupPrimPArray,
+ lookupPrimMethod
) where
import Vectorise.Monad.Base
No -> return Nothing
} }
- new_info genv = updVectInfo genv (mg_types guts) info
+ new_info genv = modVectInfo genv (mg_types guts) info
selectBackendErr = sLit "To use -fvectorise select a DPH backend with -fdph-par or -fdph-seq"
-- Var ------------------------------------------------------------------------
-- | Lookup the vectorised and\/or lifted versions of this variable.
--- If it's in the global environment we get the vectorised version.
+-- If it's in the global environment we get the vectorised version.
-- If it's in the local environment we get both the vectorised and lifted version.
lookupVar :: Var -> VM (Scope Var (Var, Var))
lookupVar v
dumpVar :: Var -> a
dumpVar var
- | Just _ <- isClassOpId_maybe var
- = cantVectorise "ClassOpId not vectorised:" (ppr var)
+ | Just _ <- isClassOpId_maybe var
+ = cantVectorise "ClassOpId not vectorised:" (ppr var)
- | otherwise
- = cantVectorise "Variable not vectorised:" (ppr var)
+ | otherwise
+ = cantVectorise "Variable not vectorised:" (ppr var)
--- local scalars --------------------------------------------------------------
+-- Global scalars --------------------------------------------------------------
addGlobalScalar :: Var -> VM ()
addGlobalScalar var
= do { traceVt "addGlobalScalar" (ppr var)
- ; updGEnv $ \env -> env{global_scalars = extendVarSet (global_scalars env) var}
- }
-
-deleteGlobalScalar :: Var -> VM ()
-deleteGlobalScalar var
- = do { traceVt "deleteGlobalScalar" (ppr var)
- ; updGEnv $ \env -> env{global_scalars = delVarSet (global_scalars env) var}
- }
+ ; updGEnv $ \env -> env{global_scalar_vars = extendVarSet (global_scalar_vars env) var}
+ }
-- Primitives -----------------------------------------------------------------
+
lookupPrimPArray :: TyCon -> VM (Maybe TyCon)
lookupPrimPArray = liftBuiltinDs . primPArray
-- Vectorisation declarations -------------------------------------------------
--- | Check whether a variable has a (non-scalar) vectorisation declaration.
+
+-- |Check whether a variable has a (non-scalar) vectorisation declaration.
+--
lookupVectDecl :: Var -> VM (Maybe (Type, CoreExpr))
lookupVectDecl var = readGEnv $ \env -> lookupVarEnv (global_vect_decls env) var
-- Scalars --------------------------------------------------------------------
--- | Get the set of global scalar variables.
+
+-- |Get the set of global scalar variables.
+--
globalScalars :: VM VarSet
-globalScalars = readGEnv global_scalars
+globalScalars = readGEnv global_scalar_vars
--- | Check whether a given variable is in the set of global scalar variables.
+-- |Check whether a given variable is in the set of global scalar variables.
+--
isGlobalScalar :: Var -> VM Bool
-isGlobalScalar var = readGEnv $ \env -> elemVarSet var (global_scalars env)
+isGlobalScalar var = readGEnv $ \env -> elemVarSet var (global_scalar_vars env)
-- TyCons ---------------------------------------------------------------------
projects / ghc-hetmet.git / commitdiff