This BIG PATCH contains most of the work for the New Coercion Representation

[ghc-hetmet.git] / compiler / vectorise / Vectorise / Utils / Base.hs

diff --git a/compiler/vectorise/Vectorise/Utils/Base.hs b/compiler/vectorise/Vectorise/Utils/Base.hs
index 490eba6..d41be1e 100644 (file)
--- a/compiler/vectorise/Vectorise/Utils/Base.hs
+++ b/compiler/vectorise/Vectorise/Utils/Base.hs
@@ -15,9 +15,11 @@ module Vectorise.Utils.Base (
        mkPDataType,
        mkBuiltinCo,
        mkVScrut,
-       
+
+        preprSynTyCon,
        pdataReprTyCon,
        pdataReprDataCon,
+        prDFunOfTyCon
 )
 where
 import Vectorise.Monad
@@ -35,6 +37,8 @@ import Literal
 import Outputable
 import FastString
 
+import Control.Monad (liftM)
+
 
 -- Simple Types ---------------------------------------------------------------
 voidType :: VM Type
@@ -129,7 +133,7 @@ mkBuiltinCo :: (Builtins -> TyCon) -> VM Coercion
 mkBuiltinCo get_tc
   = do
       tc <- builtin get_tc
-      return $ mkTyConApp tc []
+      return $ mkTyConAppCo tc []
 
 
 mkVScrut :: VExpr -> VM (CoreExpr, CoreExpr, TyCon, [Type])
@@ -140,6 +144,9 @@ mkVScrut (ve, le)
   where
     ty = exprType ve
 
+preprSynTyCon :: Type -> VM (TyCon, [Type])
+preprSynTyCon ty = builtin preprTyCon >>= (`lookupFamInst` [ty])
+
 pdataReprTyCon :: Type -> VM (TyCon, [Type])
 pdataReprTyCon ty = builtin pdataTyCon >>= (`lookupFamInst` [ty])
 
@@ -151,4 +158,9 @@ pdataReprDataCon ty
       let [dc] = tyConDataCons tc
       return (dc, arg_tys)
 
+prDFunOfTyCon :: TyCon -> VM CoreExpr
+prDFunOfTyCon tycon
+  = liftM Var
+  . maybeCantVectoriseM "No PR dictionary for tycon" (ppr tycon)
+  $ lookupTyConPR tycon