X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fvectorise%2FVectMonad.hs;h=a7e0a28b7e6ac48440fae20aad3964978b49b0b9;hb=57bb5a4f78e5b9d158ca5b90fafeb296ea88dec6;hp=5ef06eed6f6af90736fbe1433c89e25988e340f3;hpb=a9192907a271905c4ec1a37b1737ce119ac48905;p=ghc-hetmet.git diff --git a/compiler/vectorise/VectMonad.hs b/compiler/vectorise/VectMonad.hs index 5ef06ee..a7e0a28 100644 --- a/compiler/vectorise/VectMonad.hs +++ b/compiler/vectorise/VectMonad.hs @@ -14,7 +14,8 @@ module VectMonad ( cloneName, cloneId, cloneVar, newExportedVar, newLocalVar, newDummyVar, newTyVar, - Builtins(..), sumTyCon, prodTyCon, combinePAVar, + Builtins(..), sumTyCon, prodTyCon, uarrTy, intPrimArrayTy, + combinePAVar, builtin, builtins, GlobalEnv(..), @@ -376,7 +377,9 @@ defTyCon tc tc' = updGEnv $ \env -> env { global_tycons = extendNameEnv (global_tycons env) (tyConName tc) tc' } lookupDataCon :: DataCon -> VM (Maybe DataCon) -lookupDataCon dc = readGEnv $ \env -> lookupNameEnv (global_datacons env) (dataConName dc) +lookupDataCon dc + | isTupleTyCon (dataConTyCon dc) = return (Just dc) + | otherwise = readGEnv $ \env -> lookupNameEnv (global_datacons env) (dataConName dc) defDataCon :: DataCon -> DataCon -> VM () defDataCon dc dc' = updGEnv $ \env -> @@ -493,9 +496,9 @@ initV hsc_env guts info p go = do builtins <- initBuiltins - let builtin_vars = initBuiltinVars builtins - builtin_tycons = initBuiltinTyCons builtins - builtin_datacons = initBuiltinDataCons builtins + builtin_vars <- initBuiltinVars builtins + builtin_tycons <- initBuiltinTyCons builtins + let builtin_datacons = initBuiltinDataCons builtins builtin_pas <- initBuiltinPAs builtins builtin_prs <- initBuiltinPRs builtins builtin_boxed <- initBuiltinBoxedTyCons builtins