X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fvectorise%2FVectBuiltIn.hs;h=35b446f383266e805808bb7bb526927b74d0cb45;hb=facf3d6c3a2eefb66ec0ecefb0e8b390ca59ac8c;hp=2338d875b9b154fe17a9c2f50773c1231224dbbb;hpb=49dca6ac4a383c6dd699263f96c2f65959782128;p=ghc-hetmet.git diff --git a/compiler/vectorise/VectBuiltIn.hs b/compiler/vectorise/VectBuiltIn.hs index 2338d87..35b446f 100644 --- a/compiler/vectorise/VectBuiltIn.hs +++ b/compiler/vectorise/VectBuiltIn.hs @@ -46,13 +46,18 @@ data Builtins = Builtins { , prTyCon :: TyCon , prDataCon :: DataCon , parrayIntPrimTyCon :: TyCon + , voidTyCon :: TyCon + , wrapTyCon :: TyCon , sumTyCons :: Array Int TyCon , closureTyCon :: TyCon + , voidVar :: Var , mkPRVar :: Var , mkClosureVar :: Var , applyClosureVar :: Var , mkClosurePVar :: Var , applyClosurePVar :: Var + , replicatePAIntPrimVar :: Var + , upToPAIntPrimVar :: Var , lengthPAVar :: Var , replicatePAVar :: Var , emptyPAVar :: Var @@ -68,6 +73,8 @@ sumTyCon n bi prodTyCon :: Int -> Builtins -> TyCon prodTyCon n bi + | n == 0 = voidTyCon bi + | n == 1 = wrapTyCon bi | n >= 2 && n <= mAX_NDP_PROD = tupleTyCon Boxed n | otherwise = pprPanic "prodTyCon" (ppr n) @@ -83,16 +90,21 @@ initBuiltins parrayIntPrimTyCon <- dsLookupTyCon parrayIntPrimTyConName closureTyCon <- dsLookupTyCon closureTyConName + voidTyCon <- lookupExternalTyCon nDP_REPR FSLIT("Void") + wrapTyCon <- lookupExternalTyCon nDP_REPR FSLIT("Wrap") sum_tcs <- mapM (lookupExternalTyCon nDP_REPR) [mkFastString ("Sum" ++ show i) | i <- [2..mAX_NDP_SUM]] let sumTyCons = listArray (2, mAX_NDP_SUM) sum_tcs + voidVar <- lookupExternalVar nDP_REPR FSLIT("void") mkPRVar <- dsLookupGlobalId mkPRName mkClosureVar <- dsLookupGlobalId mkClosureName applyClosureVar <- dsLookupGlobalId applyClosureName mkClosurePVar <- dsLookupGlobalId mkClosurePName applyClosurePVar <- dsLookupGlobalId applyClosurePName + replicatePAIntPrimVar <- dsLookupGlobalId replicatePAIntPrimName + upToPAIntPrimVar <- dsLookupGlobalId upToPAIntPrimName lengthPAVar <- dsLookupGlobalId lengthPAName replicatePAVar <- dsLookupGlobalId replicatePAName emptyPAVar <- dsLookupGlobalId emptyPAName @@ -110,13 +122,18 @@ initBuiltins , prTyCon = prTyCon , prDataCon = prDataCon , parrayIntPrimTyCon = parrayIntPrimTyCon + , voidTyCon = voidTyCon + , wrapTyCon = wrapTyCon , sumTyCons = sumTyCons , closureTyCon = closureTyCon + , voidVar = voidVar , mkPRVar = mkPRVar , mkClosureVar = mkClosureVar , applyClosureVar = applyClosureVar , mkClosurePVar = mkClosurePVar , applyClosurePVar = applyClosurePVar + , replicatePAIntPrimVar = replicatePAIntPrimVar + , upToPAIntPrimVar = upToPAIntPrimVar , lengthPAVar = lengthPAVar , replicatePAVar = replicatePAVar , emptyPAVar = emptyPAVar @@ -144,16 +161,18 @@ initBuiltinDicts ps where (tcs, mods, fss) = unzip3 ps -initBuiltinPAs = initBuiltinDicts builtinPAs +initBuiltinPAs = initBuiltinDicts . builtinPAs -builtinPAs :: [(Name, Module, FastString)] -builtinPAs = [ - mk closureTyConName nDP_CLOSURE FSLIT("dPA_Clo") - , mk unitTyConName nDP_INSTANCES FSLIT("dPA_Unit") +builtinPAs :: Builtins -> [(Name, Module, FastString)] +builtinPAs bi + = [ + mk closureTyConName nDP_CLOSURE FSLIT("dPA_Clo") + , mk (tyConName $ voidTyCon bi) nDP_REPR FSLIT("dPA_Void") + , mk unitTyConName nDP_INSTANCES FSLIT("dPA_Unit") - , mk intTyConName nDP_INSTANCES FSLIT("dPA_Int") - ] - ++ tups + , mk intTyConName nDP_INSTANCES FSLIT("dPA_Int") + ] + ++ tups where mk name mod fs = (name, mod, fs) @@ -168,6 +187,8 @@ builtinPRs :: Builtins -> [(Name, Module, FastString)] builtinPRs bi = [ mk (tyConName unitTyCon) nDP_REPR FSLIT("dPR_Unit") + , mk (tyConName $ voidTyCon bi) nDP_REPR FSLIT("dPR_Void") + , mk (tyConName $ wrapTyCon bi) nDP_REPR FSLIT("dPR_Wrap") , mk closureTyConName nDP_CLOSURE FSLIT("dPR_Clo") -- temporary