X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fvectorise%2FVectBuiltIn.hs;h=4f27b1e5c5b8ab2a1fd2529d4e6aecc8da7bccbb;hb=e78adae754d3db1ec4175b66604bd633c8bb16e3;hp=e340cd1cf7d105ef53e79df511c85b7638c4f7b8;hpb=ee79af08084c320762b6b684e2ce8198395cf089;p=ghc-hetmet.git diff --git a/compiler/vectorise/VectBuiltIn.hs b/compiler/vectorise/VectBuiltIn.hs index e340cd1..4f27b1e 100644 --- a/compiler/vectorise/VectBuiltIn.hs +++ b/compiler/vectorise/VectBuiltIn.hs @@ -46,8 +46,11 @@ 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 @@ -70,7 +73,8 @@ sumTyCon n bi prodTyCon :: Int -> Builtins -> TyCon prodTyCon n bi - | n >= 2 && n <= mAX_NDP_PROD = tupleTyCon Boxed n + | n == 1 = wrapTyCon bi + | n >= 0 && n <= mAX_NDP_PROD = tupleTyCon Boxed n | otherwise = pprPanic "prodTyCon" (ppr n) initBuiltins :: DsM Builtins @@ -85,11 +89,14 @@ 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 @@ -114,8 +121,11 @@ initBuiltins , prTyCon = prTyCon , prDataCon = prDataCon , parrayIntPrimTyCon = parrayIntPrimTyCon + , voidTyCon = voidTyCon + , wrapTyCon = wrapTyCon , sumTyCons = sumTyCons , closureTyCon = closureTyCon + , voidVar = voidVar , mkPRVar = mkPRVar , mkClosureVar = mkClosureVar , applyClosureVar = applyClosureVar @@ -150,16 +160,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) @@ -174,6 +186,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