diff options
| author | Adam Sandberg Eriksson <adam@sandbergericsson.se> | 2015-08-10 12:55:50 +0200 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2015-08-10 13:40:21 +0200 |
| commit | b4ed13000cf0cbbb5916727dad018d91c10f1fd8 (patch) | |
| tree | d8d6469ff5a2f6c90042c556ed492a6cc39d0da7 /compiler/iface/BuildTyCl.hs | |
| parent | a40ec755d8e020cd4b87975f5a751f1e35c36977 (diff) | |
| download | haskell-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/iface/BuildTyCl.hs')
| -rw-r--r-- | compiler/iface/BuildTyCl.hs | 32 |
1 files changed, 19 insertions, 13 deletions
diff --git a/compiler/iface/BuildTyCl.hs b/compiler/iface/BuildTyCl.hs index 28a5f68f47..0a922e86e1 100644 --- a/compiler/iface/BuildTyCl.hs +++ b/compiler/iface/BuildTyCl.hs @@ -129,20 +129,22 @@ mkNewTyConRhs tycon_name tycon con ------------------------------------------------------ buildDataCon :: FamInstEnvs -> Name -> Bool - -> [HsBang] - -> [Name] -- Field labels - -> [TyVar] -> [TyVar] -- Univ and ext - -> [(TyVar,Type)] -- Equality spec - -> ThetaType -- Does not include the "stupid theta" - -- or the GADT equalities - -> [Type] -> Type -- Argument and result types - -> TyCon -- Rep tycon - -> TcRnIf m n DataCon + -> [HsSrcBang] + -> Maybe [HsImplBang] + -- See Note [Bangs on imported data constructors] in MkId + -> [Name] -- Field labels + -> [TyVar] -> [TyVar] -- Univ and ext + -> [(TyVar,Type)] -- Equality spec + -> ThetaType -- Does not include the "stupid theta" + -- or the GADT equalities + -> [Type] -> Type -- Argument and result types + -> TyCon -- Rep tycon + -> TcRnIf m n DataCon -- A wrapper for DataCon.mkDataCon that -- a) makes the worker Id -- b) makes the wrapper Id if necessary, including -- allocating its unique (hence monadic) -buildDataCon fam_envs src_name declared_infix arg_stricts field_lbls +buildDataCon fam_envs src_name declared_infix src_bangs impl_bangs field_lbls univ_tvs ex_tvs eq_spec ctxt arg_tys res_ty rep_tycon = do { wrap_name <- newImplicitBinder src_name mkDataConWrapperOcc ; work_name <- newImplicitBinder src_name mkDataConWorkerOcc @@ -155,12 +157,13 @@ buildDataCon fam_envs src_name declared_infix arg_stricts field_lbls ; let stupid_ctxt = mkDataConStupidTheta rep_tycon arg_tys univ_tvs data_con = mkDataCon src_name declared_infix - arg_stricts field_lbls + src_bangs field_lbls univ_tvs ex_tvs eq_spec ctxt arg_tys res_ty rep_tycon stupid_ctxt dc_wrk dc_rep dc_wrk = mkDataConWorkId work_name data_con - dc_rep = initUs_ us (mkDataConRep dflags fam_envs wrap_name data_con) + dc_rep = initUs_ us (mkDataConRep dflags fam_envs wrap_name + impl_bangs data_con) ; return data_con } @@ -272,7 +275,8 @@ buildClass tycon_name tvs roles sc_theta fds at_items sig_stuff mindef tc_isrec ; dict_con <- buildDataCon (panic "buildClass: FamInstEnvs") datacon_name False -- Not declared infix - (map (const HsLazy) args) + (map (const no_bang) args) + (Just (map (const HsLazy) args)) [{- No fields -}] tvs [{- no existentials -}] [{- No GADT equalities -}] @@ -308,6 +312,8 @@ buildClass tycon_name tvs roles sc_theta fds at_items sig_stuff mindef tc_isrec ; traceIf (text "buildClass" <+> ppr tycon) ; return result } where + no_bang = HsSrcBang Nothing NoSrcUnpack NoSrcStrict + mk_op_item :: Class -> TcMethInfo -> TcRnIf n m ClassOpItem mk_op_item rec_clas (op_name, dm_spec, _) = do { dm_info <- case dm_spec of |