diff options
Diffstat (limited to 'compiler/vectorise/Vectorise/Utils/Base.hs')
| -rw-r--r-- | compiler/vectorise/Vectorise/Utils/Base.hs | 259 |
1 files changed, 0 insertions, 259 deletions
diff --git a/compiler/vectorise/Vectorise/Utils/Base.hs b/compiler/vectorise/Vectorise/Utils/Base.hs deleted file mode 100644 index 88058e22d9..0000000000 --- a/compiler/vectorise/Vectorise/Utils/Base.hs +++ /dev/null @@ -1,259 +0,0 @@ -{-# LANGUAGE CPP #-} - -module Vectorise.Utils.Base - ( voidType - , newLocalVVar - - , mkDataConTag - , mkWrapType - , mkClosureTypes - , mkPReprType - , mkPDataType, mkPDatasType - , splitPrimTyCon - , mkBuiltinCo - - , wrapNewTypeBodyOfWrap - , unwrapNewTypeBodyOfWrap - , wrapNewTypeBodyOfPDataWrap - , unwrapNewTypeBodyOfPDataWrap - , wrapNewTypeBodyOfPDatasWrap - , unwrapNewTypeBodyOfPDatasWrap - - , pdataReprTyCon - , pdataReprTyConExact - , pdatasReprTyConExact - , pdataUnwrapScrut - - , preprFamInst -) where - -import Vectorise.Monad -import Vectorise.Vect -import Vectorise.Builtins - -import CoreSyn -import CoreUtils -import FamInstEnv -import Coercion -import Type -import TyCon -import DataCon -import MkId -import DynFlags -import FastString - -#include "HsVersions.h" - --- Simple Types --------------------------------------------------------------- - -voidType :: VM Type -voidType = mkBuiltinTyConApp voidTyCon [] - - --- Name Generation ------------------------------------------------------------ - -newLocalVVar :: FastString -> Type -> VM VVar -newLocalVVar fs vty - = do - lty <- mkPDataType vty - vv <- newLocalVar fs vty - lv <- newLocalVar fs lty - return (vv,lv) - - --- Constructors --------------------------------------------------------------- - -mkDataConTag :: DynFlags -> DataCon -> CoreExpr -mkDataConTag dflags = mkIntLitInt dflags . dataConTagZ - - --- Type Construction ---------------------------------------------------------- - --- |Make an application of the 'Wrap' type constructor. --- -mkWrapType :: Type -> VM Type -mkWrapType ty = mkBuiltinTyConApp wrapTyCon [ty] - --- |Make an application of the closure type constructor. --- -mkClosureTypes :: [Type] -> Type -> VM Type -mkClosureTypes = mkBuiltinTyConApps closureTyCon - --- |Make an application of the 'PRepr' type constructor. --- -mkPReprType :: Type -> VM Type -mkPReprType ty = mkBuiltinTyConApp preprTyCon [ty] - --- | Make an application of the 'PData' tycon to some argument. --- -mkPDataType :: Type -> VM Type -mkPDataType ty = mkBuiltinTyConApp pdataTyCon [ty] - --- | Make an application of the 'PDatas' tycon to some argument. --- -mkPDatasType :: Type -> VM Type -mkPDatasType ty = mkBuiltinTyConApp pdatasTyCon [ty] - --- Make an application of a builtin type constructor to some arguments. --- -mkBuiltinTyConApp :: (Builtins -> TyCon) -> [Type] -> VM Type -mkBuiltinTyConApp get_tc tys - = do { tc <- builtin get_tc - ; return $ mkTyConApp tc tys - } - --- Make a cascading application of a builtin type constructor. --- -mkBuiltinTyConApps :: (Builtins -> TyCon) -> [Type] -> Type -> VM Type -mkBuiltinTyConApps get_tc tys ty - = do { tc <- builtin get_tc - ; return $ foldr (mk tc) ty tys - } - where - mk tc ty1 ty2 = mkTyConApp tc [ty1,ty2] - - --- Type decomposition --------------------------------------------------------- - --- |Checks if a type constructor is defined in 'GHC.Prim' (e.g., 'Int#'); if so, returns it. --- -splitPrimTyCon :: Type -> Maybe TyCon -splitPrimTyCon ty - | Just (tycon, []) <- splitTyConApp_maybe ty - , isPrimTyCon tycon - = Just tycon - | otherwise = Nothing - - --- Coercion Construction ----------------------------------------------------- - --- |Make a representational coercion to some builtin type. --- -mkBuiltinCo :: (Builtins -> TyCon) -> VM Coercion -mkBuiltinCo get_tc - = do { tc <- builtin get_tc - ; return $ mkTyConAppCo Representational tc [] - } - - --- Wrapping and unwrapping the 'Wrap' newtype --------------------------------- - --- |Apply the constructor wrapper of the 'Wrap' /newtype/. --- -wrapNewTypeBodyOfWrap :: CoreExpr -> Type -> VM CoreExpr -wrapNewTypeBodyOfWrap e ty - = do { wrap_tc <- builtin wrapTyCon - ; return $ wrapNewTypeBody wrap_tc [ty] e - } - --- |Strip the constructor wrapper of the 'Wrap' /newtype/. --- -unwrapNewTypeBodyOfWrap :: CoreExpr -> Type -> VM CoreExpr -unwrapNewTypeBodyOfWrap e ty - = do { wrap_tc <- builtin wrapTyCon - ; return $ unwrapNewTypeBody wrap_tc [ty] e - } - --- |Apply the constructor wrapper of the 'PData' /newtype/ instance of 'Wrap'. --- -wrapNewTypeBodyOfPDataWrap :: CoreExpr -> Type -> VM CoreExpr -wrapNewTypeBodyOfPDataWrap e ty - = do { wrap_tc <- builtin wrapTyCon - ; pwrap_tc <- pdataReprTyConExact wrap_tc - ; return $ wrapNewTypeBody pwrap_tc [ty] e - } - --- |Strip the constructor wrapper of the 'PData' /newtype/ instance of 'Wrap'. --- -unwrapNewTypeBodyOfPDataWrap :: CoreExpr -> Type -> VM CoreExpr -unwrapNewTypeBodyOfPDataWrap e ty - = do { wrap_tc <- builtin wrapTyCon - ; pwrap_tc <- pdataReprTyConExact wrap_tc - ; return $ unwrapNewTypeBody pwrap_tc [ty] (unwrapFamInstScrut pwrap_tc [ty] e) - } - --- |Apply the constructor wrapper of the 'PDatas' /newtype/ instance of 'Wrap'. --- -wrapNewTypeBodyOfPDatasWrap :: CoreExpr -> Type -> VM CoreExpr -wrapNewTypeBodyOfPDatasWrap e ty - = do { wrap_tc <- builtin wrapTyCon - ; pwrap_tc <- pdatasReprTyConExact wrap_tc - ; return $ wrapNewTypeBody pwrap_tc [ty] e - } - --- |Strip the constructor wrapper of the 'PDatas' /newtype/ instance of 'Wrap'. --- -unwrapNewTypeBodyOfPDatasWrap :: CoreExpr -> Type -> VM CoreExpr -unwrapNewTypeBodyOfPDatasWrap e ty - = do { wrap_tc <- builtin wrapTyCon - ; pwrap_tc <- pdatasReprTyConExact wrap_tc - ; return $ unwrapNewTypeBody pwrap_tc [ty] (unwrapFamInstScrut pwrap_tc [ty] e) - } - - --- 'PData' representation types ---------------------------------------------- - --- |Get the representation tycon of the 'PData' data family for a given type. --- --- This tycon does not appear explicitly in the source program — see Note [PData TyCons] in --- 'Vectorise.Generic.Description': --- --- @pdataReprTyCon {Sum2} = {PDataSum2}@ --- --- The type for which we look up a 'PData' instance may be more specific than the type in the --- instance declaration. In that case the second component of the result will be more specific than --- a set of distinct type variables. --- -pdataReprTyCon :: Type -> VM (TyCon, [Type]) -pdataReprTyCon ty - = do - { FamInstMatch { fim_instance = famInst - , fim_tys = tys } <- builtin pdataTyCon >>= (`lookupFamInst` [ty]) - ; return (dataFamInstRepTyCon famInst, tys) - } - --- |Get the representation tycon of the 'PData' data family for a given type constructor. --- --- For example, for a binary type constructor 'T', we determine the representation type constructor --- for 'PData (T a b)'. --- -pdataReprTyConExact :: TyCon -> VM TyCon -pdataReprTyConExact tycon - = do { -- look up the representation tycon; if there is a match at all, it will be exact - ; -- (i.e.,' _tys' will be distinct type variables) - ; (ptycon, _tys) <- pdataReprTyCon (tycon `mkTyConApp` mkTyVarTys (tyConTyVars tycon)) - ; return ptycon - } - --- |Get the representation tycon of the 'PDatas' data family for a given type constructor. --- --- For example, for a binary type constructor 'T', we determine the representation type constructor --- for 'PDatas (T a b)'. --- -pdatasReprTyConExact :: TyCon -> VM TyCon -pdatasReprTyConExact tycon - = do { -- look up the representation tycon; if there is a match at all, it will be exact - ; (FamInstMatch { fim_instance = ptycon }) <- pdatasReprTyCon (tycon `mkTyConApp` mkTyVarTys (tyConTyVars tycon)) - ; return $ dataFamInstRepTyCon ptycon - } - where - pdatasReprTyCon ty = builtin pdatasTyCon >>= (`lookupFamInst` [ty]) - --- |Unwrap a 'PData' representation scrutinee. --- -pdataUnwrapScrut :: VExpr -> VM (CoreExpr, CoreExpr, DataCon) -pdataUnwrapScrut (ve, le) - = do { (tc, arg_tys) <- pdataReprTyCon ty - ; let [dc] = tyConDataCons tc - ; return (ve, unwrapFamInstScrut tc arg_tys le, dc) - } - where - ty = exprType ve - - --- 'PRepr' representation types ---------------------------------------------- - --- |Get the representation tycon of the 'PRepr' type family for a given type. --- -preprFamInst :: Type -> VM FamInstMatch -preprFamInst ty = builtin preprTyCon >>= (`lookupFamInst` [ty]) |