diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2012-12-23 15:38:48 +0000 |
|---|---|---|
| committer | Simon Peyton Jones <simonpj@microsoft.com> | 2012-12-23 15:38:48 +0000 |
| commit | 1ee1cd4194555e498d05bfc391b7b0e635d11e29 (patch) | |
| tree | 96db09d1078848cd4a9ef66972fb3d5310512b03 /compiler/vectorise/Vectorise | |
| parent | d3e2912ac2048346828539e0dfef6c0cefef0d38 (diff) | |
| download | haskell-1ee1cd4194555e498d05bfc391b7b0e635d11e29.tar.gz | |
Make {-# UNPACK #-} work for type/data family invocations
This fixes most of Trac #3990. Consider
data family D a
data instance D Double = CD Int Int
data T = T {-# UNPACK #-} !(D Double)
Then we want the (D Double unpacked).
To do this we need to construct a suitable coercion, and it's much
safer to record that coercion in the interface file, lest the in-scope
instances differ somehow. That in turn means elaborating the HsBang
type to include a coercion.
To do that I moved HsBang from BasicTypes to DataCon, which caused
quite a few minor knock-on changes.
Interface-file format has changed!
Still to do: need to do knot-tying to allow instances to take effect
within the same module.
Diffstat (limited to 'compiler/vectorise/Vectorise')
| -rw-r--r-- | compiler/vectorise/Vectorise/Generic/PData.hs | 9 | ||||
| -rw-r--r-- | compiler/vectorise/Vectorise/Type/TyConDecl.hs | 4 |
2 files changed, 8 insertions, 5 deletions
diff --git a/compiler/vectorise/Vectorise/Generic/PData.hs b/compiler/vectorise/Vectorise/Generic/PData.hs index 49997f8502..a733d35fdf 100644 --- a/compiler/vectorise/Vectorise/Generic/PData.hs +++ b/compiler/vectorise/Vectorise/Generic/PData.hs @@ -12,6 +12,7 @@ import Vectorise.Monad import Vectorise.Builtins import Vectorise.Generic.Description import Vectorise.Utils +import Vectorise.Env( GlobalEnv( global_fam_inst_env ) ) import BasicTypes import BuildTyCl @@ -69,8 +70,8 @@ buildPDataDataCon orig_name vect_tc repr_tc repr = do let tvs = tyConTyVars vect_tc dc_name <- mkLocalisedName mkPDataDataConOcc orig_name comp_tys <- mkSumTys repr_sel_ty mkPDataType repr - - liftDs $ buildDataCon dc_name + fam_envs <- readGEnv global_fam_inst_env + liftDs $ buildDataCon fam_envs dc_name False -- not infix (map (const HsNoBang) comp_tys) [] -- no field labels @@ -108,8 +109,8 @@ buildPDatasDataCon orig_name vect_tc repr_tc repr dc_name <- mkLocalisedName mkPDatasDataConOcc orig_name comp_tys <- mkSumTys repr_sels_ty mkPDatasType repr - - liftDs $ buildDataCon dc_name + fam_envs <- readGEnv global_fam_inst_env + liftDs $ buildDataCon fam_envs dc_name False -- not infix (map (const HsNoBang) comp_tys) [] -- no field labels diff --git a/compiler/vectorise/Vectorise/Type/TyConDecl.hs b/compiler/vectorise/Vectorise/Type/TyConDecl.hs index 05b78246db..d1c5ca53b1 100644 --- a/compiler/vectorise/Vectorise/Type/TyConDecl.hs +++ b/compiler/vectorise/Vectorise/Type/TyConDecl.hs @@ -5,6 +5,7 @@ module Vectorise.Type.TyConDecl ( import Vectorise.Type.Type import Vectorise.Monad +import Vectorise.Env( GlobalEnv( global_fam_inst_env ) ) import BuildTyCl import Class import Type @@ -169,7 +170,8 @@ vectDataCon dc ; tycon' <- vectTyCon tycon ; arg_tys <- mapM vectType rep_arg_tys ; let ret_ty = mkFamilyTyConApp tycon' (mkTyVarTys univ_tvs) - ; liftDs $ buildDataCon + ; fam_envs <- readGEnv global_fam_inst_env + ; liftDs $ buildDataCon fam_envs name' (dataConIsInfix dc) -- infix if the original is (dataConStrictMarks dc) -- strictness as original constructor |