import Panic (panic)
import Outputable (Outputable(ppr), pprPanic)
import UniqSupply (UniqSupply, splitUniqSupply, uniqFromSupply)
import Panic (panic)
import Outputable (Outputable(ppr), pprPanic)
import UniqSupply (UniqSupply, splitUniqSupply, uniqFromSupply)
import Id (Id, mkSysLocal)
import Name (Name)
import VarSet (VarSet, emptyVarSet, extendVarSet, varSetElems )
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 PrelInfo ( primOpId )
import CoreSyn (Expr(..), Bind(..), CoreBndr, CoreExpr, CoreBind, mkApps)
import CoreUtils (exprType)
-- generate a new local variable whose name is based on the given lexeme and
-- whose type is as specified in the second argument (EXPORTED)
--
-- 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 lexeme ty = Flatten $ \state ->
let
(us1, us2) = splitUniqSupply (us state)
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)
--
-- generate a non-recursive binding using a new binder whose name is derived
-- from the given lexeme (EXPORTED)
--
-- 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
--
-- 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
--
-- 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 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 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)
-- 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,
(r, packedState') = unFlatten m packedState
resState = state { -- revert to the unpacked context
ctxtVar = ctxtVar state,
}
bndrs = map mkCoreBind . varSetElems . usedVars $ packedState'
-- generate a binding for the packed variant of a context variable
--
mkCoreBind var = let
}
bndrs = map mkCoreBind . varSetElems . usedVars $ packedState'
-- generate a binding for the packed variant of a context variable
--
mkCoreBind var = let
-- maps it to (this may either be simply the lifted version of the original
-- variable or a packed variant of that variable)
--
-- maps it to (this may either be simply the lifted version of the original
-- variable or a packed variant of that variable)
--
in case lookupVarEnv (ctxtEnv s) var of
Just liftedVar -> (Var liftedVar,
s {usedVars = usedVars s `extendVarSet` var})
in case lookupVarEnv (ctxtEnv s) var of
Just liftedVar -> (Var liftedVar,
s {usedVars = usedVars s `extendVarSet` var})
len = fst $ unFlatten (mk'lengthP v'elemType (Var v)) s
in
(fst $ unFlatten (mk'replicateP (exprType e) len e ) s, s)
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)
--
-- pick those variables of the given set that occur (if albeit in lifted form)
-- in the current parallel context (EXPORTED)
--
- {- | name == floatPrimTyConName = neqFloatName -}
- {- | name == doublePrimTyConName = neqDoubleName -}
+ {- | name == floatPrimTyConName = neqFloatName -}
+ {- | name == doublePrimTyConName = neqDoubleName -}