diff options
author | Ben Gamari <ben@smart-cactus.org> | 2015-10-29 17:41:34 +0100 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2015-10-29 17:42:26 +0100 |
commit | bbaf76f949426c91d6abbbc5eced1f705530087b (patch) | |
tree | 3c25529a062e94493d874349d55f71cfaa3e6dea /compiler/vectorise | |
parent | bef2f03e4d56d88a7e9752a7afd6a0a35616da6c (diff) | |
download | haskell-bbaf76f949426c91d6abbbc5eced1f705530087b.tar.gz |
Revert "Generate Typeable info at definition sites"
This reverts commit bef2f03e4d56d88a7e9752a7afd6a0a35616da6c.
This merge was botched
Also reverts haddock submodule.
Diffstat (limited to 'compiler/vectorise')
-rw-r--r-- | compiler/vectorise/Vectorise/Generic/PData.hs | 4 | ||||
-rw-r--r-- | compiler/vectorise/Vectorise/Type/Env.hs | 4 | ||||
-rw-r--r-- | compiler/vectorise/Vectorise/Type/TyConDecl.hs | 7 |
3 files changed, 5 insertions, 10 deletions
diff --git a/compiler/vectorise/Vectorise/Generic/PData.hs b/compiler/vectorise/Vectorise/Generic/PData.hs index b69a773626..fc0192c744 100644 --- a/compiler/vectorise/Vectorise/Generic/PData.hs +++ b/compiler/vectorise/Vectorise/Generic/PData.hs @@ -59,7 +59,7 @@ buildDataFamInst name' fam_tc vect_tc rhs rec_flag -- FIXME: is this ok? False -- Not promotable False -- not GADT syntax - (DataFamInstTyCon ax fam_tc pat_tys) + (FamInstTyCon ax fam_tc pat_tys) ; liftDs $ newFamInst (DataFamilyInst rep_tc) ax } where tyvars = tyConTyVars vect_tc @@ -79,7 +79,6 @@ buildPDataDataCon orig_name vect_tc repr_tc repr fam_envs <- readGEnv global_fam_inst_env liftDs $ buildDataCon fam_envs dc_name False -- not infix - NotPromoted -- not promotable (map (const no_bang) comp_tys) (Just $ map (const HsLazy) comp_tys) [] -- no field labels @@ -122,7 +121,6 @@ buildPDatasDataCon orig_name vect_tc repr_tc repr fam_envs <- readGEnv global_fam_inst_env liftDs $ buildDataCon fam_envs dc_name False -- not infix - NotPromoted -- not promotable (map (const no_bang) comp_tys) (Just $ map (const HsLazy) comp_tys) [] -- no field labels diff --git a/compiler/vectorise/Vectorise/Type/Env.hs b/compiler/vectorise/Vectorise/Type/Env.hs index 8396e2cafa..47b1caa516 100644 --- a/compiler/vectorise/Vectorise/Type/Env.hs +++ b/compiler/vectorise/Vectorise/Type/Env.hs @@ -323,9 +323,7 @@ vectTypeEnv tycons vectTypeDecls vectClassDecls addParallelTyConAndCons tycon = do { addGlobalParallelTyCon tycon - ; mapM_ addGlobalParallelVar [ id | dc <- tyConDataCons tycon - , AnId id <- dataConImplicitTyThings dc ] - -- Ignoring the promoted tycon; hope that's ok + ; mapM_ addGlobalParallelVar . concatMap dataConImplicitIds . tyConDataCons $ tycon } -- Add a mapping from the original to vectorised type constructor to the vectorisation map. diff --git a/compiler/vectorise/Vectorise/Type/TyConDecl.hs b/compiler/vectorise/Vectorise/Type/TyConDecl.hs index 40f28d18d8..910aba473a 100644 --- a/compiler/vectorise/Vectorise/Type/TyConDecl.hs +++ b/compiler/vectorise/Vectorise/Type/TyConDecl.hs @@ -7,7 +7,6 @@ import Vectorise.Type.Type import Vectorise.Monad import Vectorise.Env( GlobalEnv( global_fam_inst_env ) ) import BuildTyCl( buildClass, buildDataCon ) -import OccName import Class import Type import TyCon @@ -99,7 +98,6 @@ vectTyConDecl tycon name' gadt_flag = isGadtSyntaxTyCon tycon -- build the vectorised type constructor - ; tc_rep_name <- mkDerivedName mkTyConRepUserOcc name' ; return $ buildAlgTyCon name' -- new name (tyConTyVars tycon) -- keep original type vars @@ -110,7 +108,7 @@ vectTyConDecl tycon name' rec_flag -- whether recursive False -- Not promotable gadt_flag -- whether in GADT syntax - (VanillaAlgTyCon tc_rep_name) + NoParentTyCon } -- some other crazy thing that we don't handle @@ -137,6 +135,8 @@ vectAlgTyConRhs :: TyCon -> AlgTyConRhs -> VM AlgTyConRhs vectAlgTyConRhs tc (AbstractTyCon {}) = do dflags <- getDynFlags cantVectorise dflags "Can't vectorise imported abstract type" (ppr tc) +vectAlgTyConRhs _tc DataFamilyTyCon + = return DataFamilyTyCon vectAlgTyConRhs _tc (DataTyCon { data_cons = data_cons , is_enum = is_enum }) @@ -184,7 +184,6 @@ vectDataCon dc ; liftDs $ buildDataCon fam_envs name' (dataConIsInfix dc) -- infix if the original is - NotPromoted -- Vectorised type is not promotable (dataConSrcBangs dc) -- strictness as original constructor (Just $ dataConImplBangs dc) [] -- no labelled fields for now |