import Panic (panic)
import Outputable (Outputable(ppr), pprPanic)
import UniqSupply (UniqSupply, splitUniqSupply, uniqFromSupply)
-import OccName (UserFS)
-import Var (Var(..))
+import Var (Var, idType)
import Id (Id, mkSysLocal)
import Name (Name)
import VarSet (VarSet, emptyVarSet, extendVarSet, varSetElems )
import PrelInfo ( primOpId )
import CoreSyn (Expr(..), Bind(..), CoreBndr, CoreExpr, CoreBind, mkApps)
import CoreUtils (exprType)
+import FastString (FastString)
-- friends
import NDPCoreUtils (parrElemTy)
-- generate a new local variable whose name is based on the given lexeme and
-- whose type is as specified in the second argument (EXPORTED)
--
-newVar :: UserFS -> Type -> Flatten Var
+newVar :: FastString -> Type -> Flatten Var
newVar lexeme ty = Flatten $ \state ->
let
(us1, us2) = splitUniqSupply (us state)
-- generate a non-recursive binding using a new binder whose name is derived
-- from the given lexeme (EXPORTED)
--
-mkBind :: UserFS -> CoreExpr -> Flatten (CoreBndr, CoreBind)
+mkBind :: FastString -> CoreExpr -> Flatten (CoreBndr, CoreBind)
mkBind lexeme e =
do
v <- newVar lexeme (exprType e)
-- extend the parallel context by the given set of variables (EXPORTED)
--
--- * if there is no parallel context at the moment, the first element of the
+-- * if there is no parallel context at the moment, the first element of the
-- variable list will be used to determine the new parallel context
--
--- * the second argument is executed in the current context extended with the
+-- * the second argument is executed in the current context extended with the
-- given variables
--
--- * the variables must already have been lifted by transforming their type,
+-- * the variables must already have been lifted by transforming their type,
-- but they *must* have retained their original name (or, at least, their
-- unique); this is needed so that they match the original variable in
-- variable environments
--
--- * any trace of the given set of variables has to be removed from the state
+-- * any trace of the given set of variables has to be removed from the state
-- at the end of this operation
--
extendContext :: [Var] -> Flatten a -> Flatten a
-- execute the second argument in a restricted context (EXPORTED)
--
--- * all variables in the current parallel context are packed according to
+-- * all variables in the current parallel context are packed according to
-- the permutation vector associated with the variable passed as the first
-- argument (ie, all elements of vectorised context variables that are
-- invalid in the restricted context are dropped)
--
--- * the returned list of core binders contains the operations that perform
+-- * the returned list of core binders contains the operations that perform
-- the restriction on all variables in the parallel context that *do* occur
-- during the execution of the second argument (ie, `liftVar' is executed at
-- least once on any such variable)
(r, packedState') = unFlatten m packedState
resState = state { -- revert to the unpacked context
ctxtVar = ctxtVar state,
- ctxtEnv = ctxtEnv state,
+ ctxtEnv = ctxtEnv state
}
bndrs = map mkCoreBind . varSetElems . usedVars $ packedState'
-- generate a binding for the packed variant of a context variable
--
mkCoreBind var = let
- rhs = fst $ unFlatten (mk'bpermuteP (varType var)
+ rhs = fst $ unFlatten (mk'bpermuteP (idType var)
(Var perm)
(Var var)
) state
-- lift a single variable in the current context (EXPORTED)
--
--- * if the variable does not occur in the context, it's value is vectorised to
+-- * if the variable does not occur in the context, it's value is vectorised to
-- match the size of the current context
--
--- * otherwise, the variable is replaced by whatever the context environment
+-- * otherwise, the variable is replaced by whatever the context environment
-- maps it to (this may either be simply the lifted version of the original
-- variable or a packed variant of that variable)
--
--- * the monad keeps track of all lifted variables that occur in the parallel
+-- * the monad keeps track of all lifted variables that occur in the parallel
-- context, so that `packContext' can determine the correct set of core
-- bindings
--
liftVar var = Flatten $ \s ->
let
v = ctxtVarErr s
- v'elemType = parrElemTy . varType $ v
+ v'elemType = parrElemTy . idType $ v
len = fst $ unFlatten (mk'lengthP v'elemType (Var v)) s
- replicated = fst $ unFlatten (mk'replicateP (varType var) len (Var var)) s
+ replicated = fst $ unFlatten (mk'replicateP (idType var) len (Var var)) s
in case lookupVarEnv (ctxtEnv s) var of
Just liftedVar -> (Var liftedVar,
s {usedVars = usedVars s `extendVarSet` var})
-- lift a constant expression in the current context (EXPORTED)
--
--- * the value of the constant expression is vectorised to match the current
+-- * the value of the constant expression is vectorised to match the current
-- parallel context
--
liftConst :: CoreExpr -> Flatten CoreExpr
liftConst e = Flatten $ \s ->
let
v = ctxtVarErr s
- v'elemType = parrElemTy . varType $ v
+ v'elemType = parrElemTy . idType $ v
len = fst $ unFlatten (mk'lengthP v'elemType (Var v)) s
in
(fst $ unFlatten (mk'replicateP (exprType e) len e ) s, s)
-- pick those variables of the given set that occur (if albeit in lifted form)
-- in the current parallel context (EXPORTED)
--
--- * the variables returned are from the given set and *not* the corresponding
+-- * the variables returned are from the given set and *not* the corresponding
-- context variables
--
intersectWithContext :: VarSet -> Flatten [Var]
where
tc = tyConAppTyCon ty
--
- neqName {- | name == charPrimTyConName = neqCharName -}
+ neqName {- | name == charPrimTyConName = neqCharName -}
| tc == intPrimTyCon = primOpId IntNeOp
- {- | name == floatPrimTyConName = neqFloatName -}
- {- | name == doublePrimTyConName = neqDoubleName -}
+ {- | name == floatPrimTyConName = neqFloatName -}
+ {- | name == doublePrimTyConName = neqDoubleName -}
| otherwise =
pprPanic "FlattenMonad.mk'neq: " (ppr ty)
--
ctxtVarErr :: FlattenState -> Var
ctxtVarErr s = case ctxtVar s of
- Nothing -> panic "FlattenMonad.ctxtVarErr: No context \
- \variable available!"
+ Nothing -> panic "FlattenMonad.ctxtVarErr: No context variable available!"
Just v -> v
-- given the name of a known function and a set of arguments (needs to include
-- get the `Id' of a known `Name'
--
--- * this can be the `Name' of any function that's visible on the toplevel of
+-- * this can be the `Name' of any function that's visible on the toplevel of
-- the current compilation unit
--
lookupName :: Name -> Flatten Id
projects / ghc-hetmet.git / blobdiff