import DataCon ( DataCon, dataConOrigArgTys, dataConWrapId, isExistentialDataCon )
import TyCon ( TyCon, tyConTyVars, tyConDataCons_maybe,
- tyConGenInfo, isNewTyCon, newTyConRep, isBoxedTupleTyCon
+ tyConGenInfo, isNewTyCon, isBoxedTupleTyCon
)
import Name ( Name, mkSystemName )
import CoreSyn ( mkLams, Expr(..), CoreExpr, AltCon(..),
genUnitTyCon, genUnitDataCon, plusTyCon, inrDataCon,
inlDataCon, crossTyCon, crossDataCon
)
-import IdInfo ( noCafNoTyGenIdInfo, setUnfoldingInfo, setArityInfo )
+import IdInfo ( noCafIdInfo, setUnfoldingInfo, setArityInfo )
import CoreUnfold ( mkTopUnfolding )
import Maybe ( isNothing )
import Unique ( Unique, builtinUniques, mkBuiltinUnique )
import Util ( takeList, dropList )
import Outputable
+import FastString
#include "HsVersions.h"
\end{code}
HsOpTy is tied to Generic definitions which is not a very good design
feature, indeed a bug. However, the check is easy to move from
tcHsType back to mk_inst_info and everything will be fine. Also see
-bug #5.
+bug #5. [I don't think that this is the case anymore after SPJ's latest
+changes in that regard. Delete this comment? -=chak/7Jun2]
Generics.lhs
tycon_ty = mkTyConApp tycon tyvar_tys -- T a b c
tyvar_tys = mkTyVarTys tyvars
- from_id_info = noCafNoTyGenIdInfo `setUnfoldingInfo` mkTopUnfolding from_fn
+ from_id_info = noCafIdInfo `setUnfoldingInfo` mkTopUnfolding from_fn
`setArityInfo` exprArity from_fn
- to_id_info = noCafNoTyGenIdInfo `setUnfoldingInfo` mkTopUnfolding to_fn
+ to_id_info = noCafIdInfo `setUnfoldingInfo` mkTopUnfolding to_fn
`setArityInfo` exprArity to_fn
-- It's important to set the arity info, so that
-- the calling convention (gotten from arity)
(from_fn, to_fn, rep_ty)
| isNewTyCon tycon
- = ( mkLams tyvars $ Lam x $ mkNewTypeBody tycon newrep_ty (Var x),
+ = ( mkLams tyvars $ Lam x $ mkNewTypeBody tycon the_arg_ty (Var x),
Var (dataConWrapId the_datacon),
- newrep_ty )
+ the_arg_ty )
| otherwise
= ( mkLams tyvars $ Lam x $ Case (Var x) x from_alts,
----------------------
-- Newtypes only
[the_datacon] = datacons
- (_, newrep_ty) = newTyConRep tycon
-
+ the_arg_ty = head (dataConOrigArgTys the_datacon)
+ -- NB: we use the arg type of the data constructor, rather than
+ -- the representation type of the newtype; in degnerate (recursive)
+ -- cases the rep type might be (), but the arg type is still T:
+ -- newtype T = MkT T
+
----------------------
-- Non-newtypes only
-- Recurse over the sum first
-------------------
genericNames :: [Name]
-genericNames = [mkSystemName (mkBuiltinUnique i) (_PK_ ('g' : show i)) | i <- [1..]]
+genericNames = [mkSystemName (mkBuiltinUnique i) (mkFastString ('g' : show i)) | i <- [1..]]
(g1:g2:g3:_) = genericNames
mk_hs_lam pats body = HsPar (HsLam (mkSimpleMatch pats body placeHolderType builtinSrcLoc))