X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fvectorise%2FVectBuiltIn.hs;h=39d4a035b955fb65a15a8969002326a1ad528c84;hb=de6c394e89bb6cb7e628eb43bf155f3e205561bf;hp=3eb39030c6a370b166fb8bcfd8fac14ea5de0dd8;hpb=eaaecbaefe18da05d618942c51286cacfa1be2af;p=ghc-hetmet.git

diff --git a/compiler/vectorise/VectBuiltIn.hs b/compiler/vectorise/VectBuiltIn.hs
index 3eb3903..39d4a03 100644
--- a/compiler/vectorise/VectBuiltIn.hs
+++ b/compiler/vectorise/VectBuiltIn.hs
@@ -1,6 +1,8 @@
 module VectBuiltIn (
   Builtins(..), sumTyCon, prodTyCon,
-  initBuiltins, initBuiltinTyCons, initBuiltinPAs, initBuiltinPRs
+  initBuiltins, initBuiltinTyCons, initBuiltinPAs, initBuiltinPRs,
+
+  primMethod, primPArray
 ) where
 
 #include "HsVersions.h"
@@ -13,11 +15,13 @@ import DataCon         ( DataCon )
 import TyCon           ( TyCon, tyConName, tyConDataCons )
 import Var             ( Var )
 import Id              ( mkSysLocal )
-import Name            ( Name )
-import OccName         ( mkVarOccFS, mkOccNameFS, tcName )
+import Name            ( Name, getOccString )
+import NameEnv
+import OccName
 
 import TypeRep         ( funTyCon )
-import TysPrim         ( intPrimTy )
+import Type            ( Type )
+import TysPrim
 import TysWiredIn      ( unitTyCon, tupleTyCon, intTyConName )
 import PrelNames
 import BasicTypes      ( Boxity(..) )
@@ -191,3 +195,23 @@ lookupExternalTyCon mod fs
 
 unitTyConName = tyConName unitTyCon
 
+
+primMethod :: TyCon -> String -> DsM (Maybe Var)
+primMethod tycon method
+  | Just suffix <- lookupNameEnv prim_ty_cons (tyConName tycon)
+  = liftM Just
+  $ dsLookupGlobalId =<< lookupOrig nDP_PRIM (mkVarOcc $ method ++ suffix)
+
+  | 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)