X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fvectorise%2FVectorise%2FType%2FEnv.hs;h=84844101a357a06798e8659c57b5a1862aa8b425;hp=61a52bc4b7b07e0ce15f9252e28d00656d187f38;hb=f2aaae9757e7532485c97f6c9a9ed5437542d1dd;hpb=19d8dcbdaac5dc10e551703b824e8237e7d5f0a1 diff --git a/compiler/vectorise/Vectorise/Type/Env.hs b/compiler/vectorise/Vectorise/Type/Env.hs index 61a52bc..8484410 100644 --- a/compiler/vectorise/Vectorise/Type/Env.hs +++ b/compiler/vectorise/Vectorise/Type/Env.hs @@ -1,12 +1,9 @@ -{-# OPTIONS_GHC -fno-warn-missing-signatures #-} {-# OPTIONS_GHC -XNoMonoLocalBinds #-} --- Roman likes local bindings --- If this module lives on I'd like to get rid of this flag in due course module Vectorise.Type.Env ( vectTypeEnv, -) -where +) where + import Vectorise.Env import Vectorise.Vect import Vectorise.Monad @@ -42,20 +39,18 @@ import MonadUtils import Control.Monad import Data.List -debug = False -dtrace s x = if debug then pprTrace "VectType" s x else x -- | Vectorise a type environment. -- The type environment contains all the type things defined in a module. -vectTypeEnv - :: TypeEnv - -> VM ( TypeEnv -- Vectorised type environment. - , [FamInst] -- New type family instances. - , [(Var, CoreExpr)]) -- New top level bindings. - +-- +vectTypeEnv :: TypeEnv + -> VM ( TypeEnv -- Vectorised type environment. + , [FamInst] -- New type family instances. + , [(Var, CoreExpr)]) -- New top level bindings. vectTypeEnv env - = dtrace (ppr env) - $ do + = do + traceVt "** vectTypeEnv" $ ppr env + cs <- readGEnv $ mk_map . global_tycons -- Split the list of TyCons into the ones we have to vectorise vs the @@ -122,14 +117,11 @@ vectTypeEnv env where mk_map env = listToUFM_Directly [(u, getUnique n /= u) | (u,n) <- nameEnvUniqueElts env] - - buildTyConBindings :: TyCon -> TyCon -> TyCon -> TyCon -> SumRepr -> VM Var buildTyConBindings orig_tc vect_tc prepr_tc pdata_tc repr = do vectDataConWorkers orig_tc vect_tc pdata_tc buildPADict vect_tc prepr_tc pdata_tc repr - vectDataConWorkers :: TyCon -> TyCon -> TyCon -> VM () vectDataConWorkers orig_tc vect_tc arr_tc = do bs <- sequence