projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
vectoriser: adapt to new superclass story part I (dictionary construction)
[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
..
0ffaa60
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,
mkPDataType,
mkBuiltinCo,
mkVScrut,
-
+
+ preprSynTyCon,
pdataReprTyCon,
pdataReprDataCon,
pdataReprTyCon,
pdataReprDataCon,
+ prDFunOfTyCon
)
where
import Vectorise.Monad
)
where
import Vectorise.Monad
@@
-35,6
+37,8
@@
import Literal
import Outputable
import FastString
import Outputable
import FastString
+import Control.Monad (liftM)
+
-- Simple Types ---------------------------------------------------------------
voidType :: VM Type
-- Simple Types ---------------------------------------------------------------
voidType :: VM Type
@@
-140,6
+144,9
@@
mkVScrut (ve, le)
where
ty = exprType ve
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])
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)
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