Builtins(..), sumTyCon, prodTyCon,
initBuiltins, initBuiltinTyCons, initBuiltinPAs, initBuiltinPRs,
- primMethod
+ primMethod, primPArray
) where
#include "HsVersions.h"
import OccName
import TypeRep ( funTyCon )
+import Type ( Type )
import TysPrim
import TysWiredIn ( unitTyCon, tupleTyCon, intTyConName )
import PrelNames
| otherwise = return Nothing
+primPArray :: TyCon -> DsM (Maybe TyCon)
+primPArray tycon
+ | Just suffix <- lookupNameEnv prim_ty_cons (tyConName tycon)
+ = liftM Just
+ $ dsLookupTyCon =<< lookupOrig nDP_PRIM (mkOccName tcName $ "PArray" ++ suffix)
+
+ | otherwise = return Nothing
+
prim_ty_cons = mkNameEnv [mk_prim intPrimTyCon]
where
mk_prim tycon = (tyConName tycon, '_' : getOccString tycon)
lookupDataCon, defDataCon,
lookupTyConPA, defTyConPA, defTyConPAs,
lookupTyConPR,
- lookupPrimMethod,
+ lookupPrimMethod, lookupPrimPArray,
lookupTyVarPA, defLocalTyVar, defLocalTyVarWithPA, localTyVars,
{-lookupInst,-} lookupFamInst
defDataCon dc dc' = updGEnv $ \env ->
env { global_datacons = extendNameEnv (global_datacons env) (dataConName dc) dc' }
+lookupPrimPArray :: TyCon -> VM (Maybe TyCon)
+lookupPrimPArray = liftDs . primPArray
+
lookupPrimMethod :: TyCon -> String -> VM (Maybe Var)
-lookupPrimMethod tycon method = liftDs $ primMethod tycon method
+lookupPrimMethod tycon = liftDs . primMethod tycon
lookupTyConPA :: TyCon -> VM (Maybe Var)
lookupTyConPA tc = readGEnv $ \env -> lookupNameEnv (global_pa_funs env) (tyConName tc)
splitPArrayTy :: Type -> Type
splitPArrayTy = splitUnTy "splitPArrayTy" parrayTyConName
+splitPrimTyCon :: Type -> Maybe TyCon
+splitPrimTyCon ty
+ | Just (tycon, []) <- splitTyConApp_maybe ty
+ , isPrimTyCon tycon
+ = Just tycon
+
+ | otherwise = Nothing
+
mkBuiltinTyConApp :: (Builtins -> TyCon) -> [Type] -> VM Type
mkBuiltinTyConApp get_tc tys
= do
mkPADictType ty = mkBuiltinTyConApp paTyCon [ty]
mkPArrayType :: Type -> VM Type
+mkPArrayType ty
+ | Just tycon <- splitPrimTyCon ty
+ = do
+ arr <- traceMaybeV "mkPArrayType" (ppr tycon)
+ $ lookupPrimPArray tycon
+ return $ mkTyConApp arr []
mkPArrayType ty = mkBuiltinTyConApp parrayTyCon [ty]
mkBuiltinCo :: (Builtins -> TyCon) -> VM Coercion
paMethod :: PAMethod -> Type -> VM CoreExpr
paMethod (method, name) ty
- | Just (tycon, []) <- splitTyConApp_maybe ty
- , isPrimTyCon tycon
+ | Just tycon <- splitPrimTyCon ty
= do
fn <- traceMaybeV "paMethod" (ppr tycon <+> text name)
$ lookupPrimMethod tycon name