X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fvectorise%2FVectBuiltIn.hs;h=4f27b1e5c5b8ab2a1fd2529d4e6aecc8da7bccbb;hb=e78adae754d3db1ec4175b66604bd633c8bb16e3;hp=2338d875b9b154fe17a9c2f50773c1231224dbbb;hpb=49dca6ac4a383c6dd699263f96c2f65959782128;p=ghc-hetmet.git diff --git a/compiler/vectorise/VectBuiltIn.hs b/compiler/vectorise/VectBuiltIn.hs index 2338d87..4f27b1e 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,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 @@ -83,16 +89,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 +121,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 +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) @@ -168,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