import RnHsSyn ( RenamedHsExpr )
import HsSyn ( HsExpr(..), InPat(..), mkSimpleMatch )
-import Type ( Type, isUnLiftedType, applyTys, tyVarsOfType, tyVarsOfTypes,
+import Type ( Type, isUnLiftedType, tyVarsOfType, tyVarsOfTypes,
mkTyVarTys, mkForAllTys, mkTyConApp,
mkFunTy, isTyVarTy, getTyVar_maybe,
- splitSigmaTy, splitTyConApp_maybe, funTyCon
+ funTyCon
)
-
+import TcType ( tcSplitTyConApp_maybe, tcSplitSigmaTy, tcSplitSigmaTy )
import DataCon ( DataCon, dataConOrigArgTys, dataConWrapId, dataConId, isExistentialDataCon )
import TyCon ( TyCon, tyConTyVars, tyConDataConsIfAvailable,
tyConGenInfo, isNewTyCon, newTyConRep, isBoxedTupleTyCon
)
import Name ( Name, mkSysLocalName )
-import CoreSyn ( mkLams, Expr(..), CoreExpr, AltCon(..), Note(..),
+import CoreSyn ( mkLams, Expr(..), CoreExpr, AltCon(..),
mkConApp, Alt, mkTyApps, mkVarApps )
import BasicTypes ( EP(..), Boxity(..) )
import Var ( TyVar )
import VarSet ( varSetElems )
-import Id ( Id, mkTemplateLocal, idType, idName,
- mkTemplateLocalsNum, mkId
+import Id ( Id, mkVanillaGlobal, idType, idName,
+ mkTemplateLocal, mkTemplateLocalsNum
)
import TysWiredIn ( genericTyCons,
genUnitTyCon, genUnitDataCon, plusTyCon, inrDataCon,
inlDataCon, crossTyCon, crossDataCon
)
-import IdInfo ( constantIdInfo, setUnfoldingInfo )
+import IdInfo ( noCafNoTyGenIdInfo, setUnfoldingInfo )
import CoreUnfold ( mkTopUnfolding )
import Unique ( mkBuiltinUnique )
import SrcLoc ( builtinSrcLoc )
-import Maybes ( expectJust )
import Outputable
#include "HsVersions.h"
-- f {| a + Int |}
validGenericInstanceType inst_ty
- = case splitTyConApp_maybe inst_ty of
+ = case tcSplitTyConApp_maybe inst_ty of
Just (tycon, tys) -> all isTyVarTy tys && tycon `elem` genericTyCons
Nothing -> False
validGenericMethodType ty
= valid tau
where
- (local_tvs, _, tau) = splitSigmaTy ty
+ (local_tvs, _, tau) = tcSplitSigmaTy ty
valid ty
| isTyVarTy ty = True
| no_tyvars_in_ty = True
- | otherwise = case splitTyConApp_maybe ty of
+ | otherwise = case tcSplitTyConApp_maybe ty of
Just (tc,tys) -> valid_tycon tc && all valid tys
Nothing -> False
where
%************************************************************************
\begin{code}
-mkTyConGenInfo :: TyCon -> Name -> Name -> Maybe (EP Id)
+mkTyConGenInfo :: TyCon -> [Name] -> Maybe (EP Id)
-- mkTyConGenInfo is called twice
-- once from TysWiredIn for Tuples
-- once the typechecker TcTyDecls
-- The two names are the names constructed by the renamer
-- for the fromT and toT conversion functions.
-mkTyConGenInfo tycon from_name to_name
+mkTyConGenInfo tycon [from_name, to_name]
| null datacons -- Abstractly imported types don't have
= Nothing -- to/from operations, (and should not need them)
= Nothing
| otherwise
- = Just (EP { fromEP = mkId from_name from_ty from_id_info,
- toEP = mkId to_name to_ty to_id_info })
+ = Just (EP { fromEP = mkVanillaGlobal from_name from_ty from_id_info,
+ toEP = mkVanillaGlobal to_name to_ty to_id_info })
where
tyvars = tyConTyVars tycon -- [a, b, c]
datacons = tyConDataConsIfAvailable tycon -- [C, D]
tycon_ty = mkTyConApp tycon tyvar_tys -- T a b c
tyvar_tys = mkTyVarTys tyvars
- from_id_info = constantIdInfo `setUnfoldingInfo` mkTopUnfolding from_fn
- to_id_info = constantIdInfo `setUnfoldingInfo` mkTopUnfolding to_fn
+ from_id_info = noCafNoTyGenIdInfo `setUnfoldingInfo` mkTopUnfolding from_fn
+ to_id_info = noCafNoTyGenIdInfo `setUnfoldingInfo` mkTopUnfolding to_fn
from_ty = mkForAllTys tyvars (mkFunTy tycon_ty rep_ty)
to_ty = mkForAllTys tyvars (mkFunTy rep_ty tycon_ty)
(from_fn, to_fn, rep_ty)
| isNewTyCon tycon
- = ( mkLams tyvars $ Lam x $ Note (Coerce newrep_ty tycon_ty) (Var x),
+ = ( mkLams tyvars $ Lam x $ Var x,
Var (dataConWrapId the_datacon),
newrep_ty )
----------------------
-- Newtypes only
[the_datacon] = datacons
- newrep_ty = applyTys (expectJust "mkGenTyConInfo" (newTyConRep tycon)) tyvar_tys
+ (_, newrep_ty) = newTyConRep tycon
----------------------
-- Non-newtypes only
where
datacon_app = mkTyApps (Var (dataConWrapId datacon)) rep_tys
-
--- This constructs the c_of datatype from a DataCon and a Type
--- The identity function at the moment.
-cOfConstr :: DataCon -> Type -> Type
-cOfConstr y z = z
-
-
----------------------------------------------------
-- Dealing with products
----------------------------------------------------
-- Takes out the ForAll and the Class restrictions
-- in front of the type of the method.
- (_,_,op_ty) = splitSigmaTy (idType sel_id)
+ (_,_,op_ty) = tcSplitSigmaTy (idType sel_id)
-- Do it again! This deals with the case where the method type
-- is polymorphic -- see notes above
- (local_tvs,_,final_ty) = splitSigmaTy op_ty
+ (local_tvs,_,final_ty) = tcSplitSigmaTy op_ty
-- Now we probably have a tycon in front
-- of us, quite probably a FunTyCon.
Just tv1 | tv == tv1 -> ep -- The class tyvar
| otherwise -> ASSERT( tv1 `elem` local_tvs) -- One of the polymorphic tyvars of the method
idEP
- Nothing -> bimapApp env (splitTyConApp_maybe ty)
+ Nothing -> bimapApp env (tcSplitTyConApp_maybe ty)
-------------------
bimapApp :: EPEnv -> Maybe (TyCon, [Type]) -> EP RenamedHsExpr