Commit 82a30378 authored by chak@cse.unsw.edu.au.'s avatar chak@cse.unsw.edu.au.
Browse files

Fix tidying of vectorised code

* We need to keep the vectorised version of a variable alive while the original is alive.
* This implies that the vectorised version needs to get into the iface if the original appears in an unfolding.
parent f8fb4a4e
......@@ -899,7 +899,7 @@ simpleOptPgm dflags this_mod binds rules vects
; return (reverse binds', substRulesForImportedIds subst' rules, substVects subst' vects) }
where
occ_anald_binds = occurAnalysePgm this_mod (\_ -> False) {- No rules active -}
rules vects binds
rules vects emptyVarEnv binds
(subst', binds') = foldl do_one (emptySubst, []) occ_anald_binds
do_one (subst, binds') bind
......
......@@ -555,15 +555,18 @@ tidyVectInfo (_, var_env) info@(VectInfo { vectInfoVar = vars
, let tidy_var = lookup_var var
tidy_var_v = lookup_var var_v
, isExportedId tidy_var
, isExportedId tidy_var_v
, isExternalId tidy_var_v
, isDataConWorkId var || not (isImplicitId var)
]
tidy_parallelVars = mkVarSet [ lookup_var var
tidy_parallelVars = mkVarSet [ tidy_var
| var <- varSetElems parallelVars
, isGlobalId var || isExportedId var]
, let tidy_var = lookup_var var
, isExternalId tidy_var]
lookup_var var = lookupWithDefaultVarEnv var_env var var
isExternalId = isExternalName . idName
\end{code}
......@@ -732,6 +735,9 @@ chooseExternalIds hsc_env mod omit_prags expose_all binds implicit_binds imp_id_
| omit_prags = ([], False)
| otherwise = addExternal expose_all refined_id
-- add vectorised version if any exists
new_ids' = new_ids ++ maybeToList (fmap snd $ lookupVarEnv vect_vars idocc)
-- 'idocc' is an *occurrence*, but we need to see the
-- unfolding in the *definition*; so look up in binder_set
refined_id = case lookupVarSet binder_set idocc of
......@@ -742,7 +748,7 @@ chooseExternalIds hsc_env mod omit_prags expose_all binds implicit_binds imp_id_
referrer' | isExportedId refined_id = refined_id
| otherwise = referrer
--
search (zip new_ids (repeat referrer') ++ rest) unfold_env' occ_env'
search (zip new_ids' (repeat referrer') ++ rest) unfold_env' occ_env'
tidy_internal :: [Id] -> UnfoldEnv -> TidyOccEnv
-> IO (UnfoldEnv, TidyOccEnv)
......
......@@ -63,9 +63,9 @@ Here's the externally-callable interface:
\begin{code}
occurAnalysePgm :: Module -- Used only in debug output
-> (Activation -> Bool)
-> [CoreRule] -> [CoreVect]
-> [CoreRule] -> [CoreVect] -> VarSet
-> CoreProgram -> CoreProgram
occurAnalysePgm this_mod active_rule imp_rules vects binds
occurAnalysePgm this_mod active_rule imp_rules vects vectVars binds
| isEmptyVarEnv final_usage
= binds'
| otherwise -- See Note [Glomming]
......@@ -76,8 +76,13 @@ occurAnalysePgm this_mod active_rule imp_rules vects binds
(final_usage, binds') = go (initOccEnv active_rule) binds
initial_uds = addIdOccs emptyDetails
(rulesFreeVars imp_rules `unionVarSet` vectsFreeVars vects)
-- The RULES and VECTORISE declarations keep things alive!
-- (rulesFreeVars imp_rules `unionVarSet` vectsFreeVars vects)
(rulesFreeVars imp_rules `unionVarSet`
vectsFreeVars vects `unionVarSet`
vectVars)
-- The RULES and VECTORISE declarations keep things alive! (For VECTORISE declarations,
-- we only get them *until* the vectoriser runs. Afterwards, these dependencies are
-- reflected in 'vectors' — see Note [Vectorisation declarations and occurences].)
-- Note [Preventing loops due to imported functions rules]
imp_rules_edges = foldr (plusVarEnv_C unionVarSet) emptyVarEnv
......@@ -118,7 +123,7 @@ Bindings
\begin{code}
occAnalBind :: OccEnv -- The incoming OccEnv
-> OccEnv -- Same, but trimmed by (binderOf bind)
-> IdEnv IdSet -- Mapping from FVs of imported RULE LHSs to RHS FVs
-> IdEnv IdSet -- Mapping from FVs of imported RULE LHSs to RHS FVs
-> CoreBind
-> UsageDetails -- Usage details of scope
-> (UsageDetails, -- Of the whole let(rec)
......
......@@ -50,6 +50,7 @@ import FastString
import SrcLoc
import Util
import Maybes
import UniqSupply ( UniqSupply, mkSplitUniqSupply, splitUniqSupply )
import Outputable
import Control.Monad
......@@ -604,14 +605,23 @@ simplifyPgmIO pass@(CoreDoSimplify max_iterations mode)
, sz == sz -- Force it
= do {
-- Occurrence analysis
let { -- During the 'InitialPhase' (i.e., before vectorisation), we need to make sure
let { -- Note [Vectorisation declarations and occurences]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- During the 'InitialPhase' (i.e., before vectorisation), we need to make sure
-- that the right-hand sides of vectorisation declarations are taken into
-- account during occurence analysis.
maybeVects = case sm_phase mode of
InitialPhase -> mg_vect_decls guts
_ -> []
-- account during occurrence analysis. After the 'InitialPhase', we need to ensure
-- that the binders representing variable vectorisation declarations are kept alive.
-- (In contrast to automatically vectorised variables, their unvectorised versions
-- don't depend on them.)
vectVars = mkVarSet $
catMaybes [ fmap snd $ lookupVarEnv (vectInfoVar (mg_vect_info guts)) bndr
| Vect bndr _ <- mg_vect_decls guts]
; (maybeVects, maybeVectVars)
= case sm_phase mode of
InitialPhase -> (mg_vect_decls guts, vectVars)
_ -> ([], vectVars)
; tagged_binds = {-# SCC "OccAnal" #-}
occurAnalysePgm this_mod active_rule rules maybeVects binds
occurAnalysePgm this_mod active_rule rules maybeVects maybeVectVars binds
} ;
Err.dumpIfSet_dyn dflags Opt_D_dump_occur_anal "Occurrence analysis"
(pprCoreBindings tagged_binds);
......
......@@ -65,7 +65,7 @@ vectModule guts@(ModGuts { mg_tcs = tycons
= do { dumpOptVt Opt_D_dump_vt_trace "Before vectorisation" $
pprCoreBindings binds
-- Pick out all 'VECTORISE [SCALAR] type' and 'VECTORISE class' pragmas
-- Pick out all 'VECTORISE [SCALAR] type' and 'VECTORISE class' pragmas
; let ty_vect_decls = [vd | vd@(VectType _ _ _) <- vect_decls]
cls_vect_decls = [vd | vd@(VectClass _) <- vect_decls]
......
......@@ -30,8 +30,6 @@ import NameSet
import Name
import NameEnv
import FastString
import TysPrim
--import TysWiredIn
import Data.Maybe
......@@ -201,8 +199,9 @@ modVectInfo env mg_ids mg_tyCons vectDecls info
{ vectInfoVar = mk_env ids (global_vars env)
, vectInfoTyCon = mk_env tyCons (global_tycons env)
, vectInfoDataCon = mk_env dataCons (global_datacons env)
, vectInfoParallelVars = global_parallel_vars env `minusVarSet` vectInfoParallelVars info
, vectInfoParallelTyCons = global_parallel_tycons env `minusNameSet` vectInfoParallelTyCons info
, vectInfoParallelVars = (global_parallel_vars env `minusVarSet` vectInfoParallelVars info)
`intersectVarSet` (mkVarSet ids)
, vectInfoParallelTyCons = global_parallel_tycons env `minusNameSet` vectInfoParallelTyCons info
}
where
vectIds = [id | Vect id _ <- vectDecls] ++
......
......@@ -159,10 +159,10 @@ vectAnnPolyExpr loop_breaker expr
-- every expression that is not constant and contains at least one operation.
--
encapsulateScalars :: CoreExprWithVectInfo -> VM CoreExprWithVectInfo
encapsulateScalars ce@(_, AnnType _ty)
encapsulateScalars ce@(_, AnnType _ty)
= return ce
encapsulateScalars ce@((_, VISimple), AnnVar v)
| isFunTy . varType $ v -- NB: diverts from the paper: encapsulate scalar function types
-- NB: diverts from the paper: encapsulate variables with scalar type (includes functions)
= liftSimpleAndCase ce
encapsulateScalars ce@(_, AnnVar _v)
= return ce
......@@ -302,6 +302,10 @@ vectExpr aexpr
-- encapsulated expression of functional type => try to vectorise as a scalar subcomputation
| (isFunTy . annExprType $ aexpr) && isVIEncaps aexpr
= vectFnExpr True False aexpr
-- encapsulated constant => vectorise as a scalar constant
| isVIEncaps aexpr
= traceVt "vectExpr (encapsulated constant):" (ppr . deAnnotate $ aexpr) >>
vectConst (deAnnotate aexpr)
vectExpr (_, AnnVar v)
= vectVar v
......@@ -310,7 +314,8 @@ vectExpr (_, AnnLit lit)
= vectConst $ Lit lit
vectExpr aexpr@(_, AnnLam _ _)
= traceVt "vectExpr [AnnLam]:" (ppr . deAnnotate $ aexpr) >> vectFnExpr True False aexpr
= traceVt "vectExpr [AnnLam]:" (ppr . deAnnotate $ aexpr) >>
vectFnExpr True False aexpr
-- SPECIAL CASE: Vectorise/lift 'patError @ ty err' by only vectorising/lifting the type 'ty';
-- its only purpose is to abort the program, but we need to adjust the type to keep CoreLint
......
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