summaryrefslogtreecommitdiff
path: root/compiler/vectorise
diff options
context:
space:
mode:
authorAdam Sandberg Eriksson <adam@sandbergericsson.se>2015-08-10 12:55:50 +0200
committerBen Gamari <ben@smart-cactus.org>2015-08-10 13:40:21 +0200
commitb4ed13000cf0cbbb5916727dad018d91c10f1fd8 (patch)
treed8d6469ff5a2f6c90042c556ed492a6cc39d0da7 /compiler/vectorise
parenta40ec755d8e020cd4b87975f5a751f1e35c36977 (diff)
downloadhaskell-b4ed13000cf0cbbb5916727dad018d91c10f1fd8.tar.gz
Replace HsBang type with HsSrcBang and HsImplBang
Updates haddock submodule. Reviewers: tibbe, goldfire, simonpj, austin, bgamari Reviewed By: simonpj, bgamari Subscribers: goldfire, thomie, mpickering Differential Revision: https://phabricator.haskell.org/D1069
Diffstat (limited to 'compiler/vectorise')
-rw-r--r--compiler/vectorise/Vectorise/Generic/PData.hs10
-rw-r--r--compiler/vectorise/Vectorise/Type/TyConDecl.hs9
2 files changed, 13 insertions, 6 deletions
diff --git a/compiler/vectorise/Vectorise/Generic/PData.hs b/compiler/vectorise/Vectorise/Generic/PData.hs
index e9a1133348..fc0192c744 100644
--- a/compiler/vectorise/Vectorise/Generic/PData.hs
+++ b/compiler/vectorise/Vectorise/Generic/PData.hs
@@ -79,7 +79,8 @@ buildPDataDataCon orig_name vect_tc repr_tc repr
fam_envs <- readGEnv global_fam_inst_env
liftDs $ buildDataCon fam_envs dc_name
False -- not infix
- (map (const HsLazy) comp_tys)
+ (map (const no_bang) comp_tys)
+ (Just $ map (const HsLazy) comp_tys)
[] -- no field labels
tvs
[] -- no existentials
@@ -88,6 +89,8 @@ buildPDataDataCon orig_name vect_tc repr_tc repr
comp_tys
(mkFamilyTyConApp repr_tc (mkTyVarTys tvs))
repr_tc
+ where
+ no_bang = HsSrcBang Nothing NoSrcUnpack NoSrcStrict
-- buildPDatasTyCon -----------------------------------------------------------
@@ -118,7 +121,8 @@ buildPDatasDataCon orig_name vect_tc repr_tc repr
fam_envs <- readGEnv global_fam_inst_env
liftDs $ buildDataCon fam_envs dc_name
False -- not infix
- (map (const HsLazy) comp_tys)
+ (map (const no_bang) comp_tys)
+ (Just $ map (const HsLazy) comp_tys)
[] -- no field labels
tvs
[] -- no existentials
@@ -127,6 +131,8 @@ buildPDatasDataCon orig_name vect_tc repr_tc repr
comp_tys
(mkFamilyTyConApp repr_tc (mkTyVarTys tvs))
repr_tc
+ where
+ no_bang = HsSrcBang Nothing NoSrcUnpack NoSrcStrict
-- Utils ----------------------------------------------------------------------
diff --git a/compiler/vectorise/Vectorise/Type/TyConDecl.hs b/compiler/vectorise/Vectorise/Type/TyConDecl.hs
index 0ef679d3ed..910aba473a 100644
--- a/compiler/vectorise/Vectorise/Type/TyConDecl.hs
+++ b/compiler/vectorise/Vectorise/Type/TyConDecl.hs
@@ -83,13 +83,13 @@ vectTyConDecl tycon name'
-- return the type constructor of the vectorised class
; return tycon'
}
-
+
-- Regular algebraic type constructor — for now, Haskell 2011-style only
| isAlgTyCon tycon
= do { unless (all isVanillaDataCon (tyConDataCons tycon)) $
do dflags <- getDynFlags
cantVectorise dflags "Currently only Haskell 2011 datatypes are supported" (ppr tycon)
-
+
-- vectorise the data constructor of the class tycon
; rhs' <- vectAlgTyConRhs tycon (algTyConRhs tycon)
@@ -98,7 +98,7 @@ vectTyConDecl tycon name'
gadt_flag = isGadtSyntaxTyCon tycon
-- build the vectorised type constructor
- ; return $ buildAlgTyCon
+ ; return $ buildAlgTyCon
name' -- new name
(tyConTyVars tycon) -- keep original type vars
(map (const Nominal) (tyConRoles tycon)) -- all roles are N for safety
@@ -108,7 +108,7 @@ vectTyConDecl tycon name'
rec_flag -- whether recursive
False -- Not promotable
gadt_flag -- whether in GADT syntax
- NoParentTyCon
+ NoParentTyCon
}
-- some other crazy thing that we don't handle
@@ -185,6 +185,7 @@ vectDataCon dc
name'
(dataConIsInfix dc) -- infix if the original is
(dataConSrcBangs dc) -- strictness as original constructor
+ (Just $ dataConImplBangs dc)
[] -- no labelled fields for now
univ_tvs -- universally quantified vars
[] -- no existential tvs for now