-
+%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
\section[TcType]{Types used in the typechecker}
newtypes, and predicates are meaningful.
* look through usage types
-The "tc" prefix is for "typechechecker", because the type checker
+The "tc" prefix is for "TypeChecker", because the type checker
is the principal client.
\begin{code}
tcSplitForAllTys, tcSplitPhiTy,
tcSplitFunTy_maybe, tcSplitFunTys, tcFunArgTy, tcFunResultTy, tcSplitFunTysN,
tcSplitTyConApp, tcSplitTyConApp_maybe, tcTyConAppTyCon, tcTyConAppArgs,
- tcSplitAppTy_maybe, tcSplitAppTy, tcSplitAppTys,
+ tcSplitAppTy_maybe, tcSplitAppTy, tcSplitAppTys, repSplitAppTy_maybe,
tcValidInstHeadTy, tcGetTyVar_maybe, tcGetTyVar,
tcSplitSigmaTy, tcMultiSplitSigmaTy,
-- Predicates.
-- Again, newtypes are opaque
tcEqType, tcEqTypes, tcEqPred, tcCmpType, tcCmpTypes, tcCmpPred, tcEqTypeX,
+ eqKind,
isSigmaTy, isOverloadedTy, isRigidTy, isBoxyTy,
isDoubleTy, isFloatTy, isIntTy, isStringTy,
- isIntegerTy, isAddrTy, isBoolTy, isUnitTy,
+ isIntegerTy, isBoolTy, isUnitTy,
isTauTy, isTauTyCon, tcIsTyVarTy, tcIsForAllTy,
---------------------------------
---------------------------------
-- Predicate types
getClassPredTys_maybe, getClassPredTys,
- isClassPred, isTyVarClassPred,
+ isClassPred, isTyVarClassPred, isEqPred,
mkDictTy, tcSplitPredTy_maybe,
isPredTy, isDictTy, tcSplitDFunTy, tcSplitDFunHead, predTyUnique,
- mkClassPred, isInheritablePred, isLinearPred, isIPPred, mkPredName,
+ mkClassPred, isInheritablePred, isIPPred, mkPredName,
dataConsStupidTheta, isRefineableTy,
---------------------------------
--------------------------------
-- Rexported from Type
Kind, -- Stuff to do with kinds is insensitive to pre/post Tc
- unliftedTypeKind, liftedTypeKind, openTypeKind, mkArrowKind, mkArrowKinds,
- isLiftedTypeKind, isUnliftedTypeKind, isOpenTypeKind,
- isArgTypeKind, isSubKind, defaultKind,
+ unliftedTypeKind, liftedTypeKind, argTypeKind,
+ openTypeKind, mkArrowKind, mkArrowKinds,
+ isLiftedTypeKind, isUnliftedTypeKind, isSubOpenTypeKind,
+ isSubArgTypeKind, isSubKind, defaultKind,
+ kindVarRef, mkKindVar,
Type, PredType(..), ThetaType,
mkForAllTy, mkForAllTys,
-- Type substitutions
TvSubst(..), -- Representation visible to a few friends
- TvSubstEnv, emptyTvSubst,
+ TvSubstEnv, emptyTvSubst, substEqSpec,
mkOpenTvSubst, zipOpenTvSubst, zipTopTvSubst, mkTopTvSubst, notElemTvSubst,
getTvSubstEnv, setTvSubstEnv, getTvInScope, extendTvInScope, lookupTyVar,
extendTvSubst, extendTvSubstList, isInScope, mkTvSubst, zipTyEnv,
#include "HsVersions.h"
-- friends:
-import TypeRep ( Type(..), funTyCon ) -- friend
-
-import Type ( -- Re-exports
- tyVarsOfType, tyVarsOfTypes, tyVarsOfPred,
- tyVarsOfTheta, Kind, PredType(..),
- ThetaType, unliftedTypeKind,
- liftedTypeKind, openTypeKind, mkArrowKind,
- isLiftedTypeKind, isUnliftedTypeKind,
- mkArrowKinds, mkForAllTy, mkForAllTys,
- defaultKind, isArgTypeKind, isOpenTypeKind,
- mkFunTy, mkFunTys, zipFunTys,
- mkTyConApp, mkAppTy,
- mkAppTys, applyTy, applyTys,
- mkTyVarTy, mkTyVarTys, mkTyConTy, mkPredTy,
- mkPredTys, isUnLiftedType,
- isUnboxedTupleType, isPrimitiveType,
- splitTyConApp_maybe,
- tidyTopType, tidyType, tidyPred, tidyTypes,
- tidyFreeTyVars, tidyOpenType, tidyOpenTypes,
- tidyTyVarBndr, tidyOpenTyVar,
- tidyOpenTyVars, tidyKind,
- isSubKind, tcView,
-
- tcEqType, tcEqTypes, tcCmpType, tcCmpTypes,
- tcEqPred, tcCmpPred, tcEqTypeX,
-
- TvSubst(..),
- TvSubstEnv, emptyTvSubst, mkTvSubst, zipTyEnv,
- mkOpenTvSubst, zipOpenTvSubst, zipTopTvSubst, mkTopTvSubst,
- getTvSubstEnv, setTvSubstEnv, getTvInScope, extendTvInScope,
- extendTvSubst, extendTvSubstList, isInScope, notElemTvSubst,
- substTy, substTys, substTyWith, substTheta,
- substTyVar, substTyVarBndr, substPred, lookupTyVar,
-
- typeKind, repType, coreView,
- pprKind, pprParendKind,
- pprType, pprParendType, pprTyThingCategory,
- pprPred, pprTheta, pprThetaArrow, pprClassPred
- )
-import TyCon ( TyCon, isUnLiftedTyCon, isSynTyCon, synTyConDefn, tyConUnique )
+import TypeRep ( Type(..), funTyCon, Kind ) -- friend
+
+import Type
+import TyCon ( TyCon, isUnLiftedTyCon, isSynTyCon, isOpenTyCon,
+ synTyConDefn, tyConUnique )
import DataCon ( DataCon, dataConStupidTheta, dataConResTys )
import Class ( Class )
-import Var ( TyVar, Id, isTcTyVar, mkTcTyVar, tyVarName, tyVarKind, tcTyVarDetails )
-import ForeignCall ( Safety, playSafe, DNType(..) )
+import Var ( TyVar, Id, isCoVar, isTcTyVar, mkTcTyVar, tyVarName, tyVarKind, tcTyVarDetails )
+import ForeignCall ( Safety, DNType(..) )
import Unify ( tcMatchTys )
import VarSet
-- others:
import DynFlags ( DynFlags, DynFlag( Opt_GlasgowExts ), dopt )
-import Name ( Name, NamedThing(..), mkInternalName, getSrcLoc )
+import Name ( Name, NamedThing(..), mkInternalName, getSrcLoc, mkSystemName )
import NameSet
import VarEnv ( TidyEnv )
-import OccName ( OccName, mkDictOcc )
+import OccName ( OccName, mkDictOcc, mkOccName, tvName )
import PrelNames -- Lots (e.g. in isFFIArgumentTy)
import TysWiredIn ( unitTyCon, charTyCon, listTyCon )
-import BasicTypes ( IPName(..), Arity, ipNameName )
+import BasicTypes ( Arity, ipNameName )
import SrcLoc ( SrcLoc, SrcSpan )
-import Util ( snocView, equalLength )
+import Util ( equalLength )
import Maybes ( maybeToBool, expectJust, mapCatMaybes )
import ListSetOps ( hasNoDups )
import List ( nubBy )
import Outputable
-import DATA_IOREF
+
+import Data.IORef
\end{code}
be the *same*, so we can't make them into skolem constants that don't unify
with each other. Alas.
-On the other hand, we *must* use skolems for signature type variables,
-becuase GADT type refinement refines skolems only.
-
One solution would be insist that in the above defn the programmer uses
the same type variable in both type signatures. But that takes explanation.
The alternative (currently implemented) is to have a special kind of skolem
-constant, SigSkokTv, which can unify with other SigSkolTvs.
+constant, SigTv, which can unify with other SigTvs. These are *not* treated
+as righd for the purposes of GADTs. And they are used *only* for pattern
+bindings and mutually recursive function bindings. See the function
+TcBinds.tcInstSig, and its use_skols parameter.
\begin{code}
-- The rest are for non-scoped skolems
| ClsSkol Class -- Bound at a class decl
| InstSkol Id -- Bound at an instance decl
+ | FamInstSkol TyCon -- Bound at a family instance decl
| PatSkol DataCon -- An existential type variable bound by a pattern for
SrcSpan -- a data constructor with an existential type. E.g.
-- data T = forall a. Eq a => MkT a
-- will become type T = forall a. a->a
--
-- With gla-exts that's right, but for H98 we should complain.
+
+---------------------------------
+-- Kind variables:
+
+mkKindName :: Unique -> Name
+mkKindName unique = mkSystemName unique kind_var_occ
+
+kindVarRef :: KindVar -> IORef MetaDetails
+kindVarRef tc =
+ ASSERT ( isTcTyVar tc )
+ case tcTyVarDetails tc of
+ MetaTv TauTv ref -> ref
+ other -> pprPanic "kindVarRef" (ppr tc)
+
+mkKindVar :: Unique -> IORef MetaDetails -> KindVar
+mkKindVar u r
+ = mkTcTyVar (mkKindName u)
+ tySuperKind -- not sure this is right,
+ -- do we need kind vars for
+ -- coercions?
+ (MetaTv TauTv r)
+
+kind_var_occ :: OccName -- Just one for all KindVars
+ -- They may be jiggled by tidying
+kind_var_occ = mkOccName tvName "k"
+\end{code}
\end{code}
%************************************************************************
tidySkolemTyVar :: TidyEnv -> TcTyVar -> (TidyEnv, TcTyVar)
-- Tidy the type inside a GenSkol, preparatory to printing it
tidySkolemTyVar env tv
- = ASSERT( isSkolemTyVar tv )
+ = ASSERT( isSkolemTyVar tv || isSigTyVar tv )
(env1, mkTcTyVar (tyVarName tv) (tyVarKind tv) info1)
where
(env1, info1) = case tcTyVarDetails tv of
- SkolemTv (GenSkol tvs ty loc) -> (env2, SkolemTv (GenSkol tvs1 ty1 loc))
+ SkolemTv info -> (env1, SkolemTv info')
+ where
+ (env1, info') = tidy_skol_info env info
+ MetaTv (SigTv info) box -> (env1, MetaTv (SigTv info') box)
+ where
+ (env1, info') = tidy_skol_info env info
+ info -> (env, info)
+
+ tidy_skol_info env (GenSkol tvs ty loc) = (env2, GenSkol tvs1 ty1 loc)
where
(env1, tvs1) = tidyOpenTyVars env tvs
(env2, ty1) = tidyOpenType env1 ty
- info -> (env, info)
+ tidy_skol_info env info = (env, info)
pprSkolTvBinding :: TcTyVar -> SDoc
-- Print info about the binding of a skolem tyvar,
-- or nothing if we don't have anything useful to say
pprSkolTvBinding tv
- = ppr_details (tcTyVarDetails tv)
+ = ASSERT ( isTcTyVar tv )
+ ppr_details (tcTyVarDetails tv)
where
ppr_details (MetaTv TauTv _) = quotes (ppr tv) <+> ptext SLIT("is a meta type variable")
ppr_details (MetaTv BoxTv _) = quotes (ppr tv) <+> ptext SLIT("is a boxy type variable")
pprSkolInfo :: SkolemInfo -> SDoc
pprSkolInfo (SigSkol ctxt) = ptext SLIT("is bound by") <+> pprUserTypeCtxt ctxt
pprSkolInfo (ClsSkol cls) = ptext SLIT("is bound by the class declaration for") <+> quotes (ppr cls)
-pprSkolInfo (InstSkol df) = ptext SLIT("is bound by the instance declaration at") <+> ppr (getSrcLoc df)
-pprSkolInfo (ArrowSkol loc) = ptext SLIT("is bound by the arrow form at") <+> ppr loc
+pprSkolInfo (InstSkol df) =
+ ptext SLIT("is bound by the instance declaration at") <+> ppr (getSrcLoc df)
+pprSkolInfo (FamInstSkol tc) =
+ ptext SLIT("is bound by the family instance declaration at") <+>
+ ppr (getSrcLoc tc)
+pprSkolInfo (ArrowSkol loc) =
+ ptext SLIT("is bound by the arrow form at") <+> ppr loc
pprSkolInfo (PatSkol dc loc) = sep [ptext SLIT("is bound by the pattern for") <+> quotes (ppr dc),
nest 2 (ptext SLIT("at") <+> ppr loc)]
pprSkolInfo (GenSkol tvs ty loc) = sep [sep [ptext SLIT("is bound by the polymorphic type"),
%************************************************************************
\begin{code}
+mkSigmaTy :: [TyVar] -> [PredType] -> Type -> Type
mkSigmaTy tyvars theta tau = mkForAllTys tyvars (mkPhiTy theta tau)
mkPhiTy :: [PredType] -> Type -> Type
isTauTyCon :: TyCon -> Bool
-- Returns False for type synonyms whose expansion is a polytype
-isTauTyCon tc | isSynTyCon tc = isTauTy (snd (synTyConDefn tc))
- | otherwise = True
+isTauTyCon tc
+ | isSynTyCon tc && not (isOpenTyCon tc) = isTauTy (snd (synTyConDefn tc))
+ | otherwise = True
---------------
isBoxyTy :: TcType -> Bool
tcSplitForAllTys ty = split ty ty []
where
split orig_ty ty tvs | Just ty' <- tcView ty = split orig_ty ty' tvs
- split orig_ty (ForAllTy tv ty) tvs = split ty ty (tv:tvs)
- split orig_ty t tvs = (reverse tvs, orig_ty)
+ split orig_ty (ForAllTy tv ty) tvs
+ | not (isCoVar tv) = split ty ty (tv:tvs)
+ split orig_ty t tvs = (reverse tvs, orig_ty)
tcIsForAllTy ty | Just ty' <- tcView ty = tcIsForAllTy ty'
-tcIsForAllTy (ForAllTy tv ty) = True
+tcIsForAllTy (ForAllTy tv ty) = not (isCoVar tv)
tcIsForAllTy t = False
-tcSplitPhiTy :: Type -> ([PredType], Type)
+tcSplitPhiTy :: Type -> (ThetaType, Type)
tcSplitPhiTy ty = split ty ty []
where
split orig_ty ty tvs | Just ty' <- tcView ty = split orig_ty ty' tvs
- split orig_ty (FunTy arg res) ts = case tcSplitPredTy_maybe arg of
- Just p -> split res res (p:ts)
- Nothing -> (reverse ts, orig_ty)
+
+ split orig_ty (ForAllTy tv ty) ts
+ | isCoVar tv = split ty ty (eq_pred:ts)
+ where
+ PredTy eq_pred = tyVarKind tv
+ split orig_ty (FunTy arg res) ts
+ | Just p <- tcSplitPredTy_maybe arg = split res res (p:ts)
split orig_ty ty ts = (reverse ts, orig_ty)
+tcSplitSigmaTy :: Type -> ([TyVar], ThetaType, Type)
tcSplitSigmaTy ty = case tcSplitForAllTys ty of
(tvs, rho) -> case tcSplitPhiTy rho of
(theta, tau) -> (tvs, theta, tau)
-----------------------
tcTyConAppTyCon :: Type -> TyCon
-tcTyConAppTyCon ty = fst (tcSplitTyConApp ty)
+tcTyConAppTyCon ty = case tcSplitTyConApp_maybe ty of
+ Just (tc, _) -> tc
+ Nothing -> pprPanic "tcTyConAppTyCon" (pprType ty)
tcTyConAppArgs :: Type -> [Type]
-tcTyConAppArgs ty = snd (tcSplitTyConApp ty)
+tcTyConAppArgs ty = case tcSplitTyConApp_maybe ty of
+ Just (_, args) -> args
+ Nothing -> pprPanic "tcTyConAppArgs" (pprType ty)
tcSplitTyConApp :: Type -> (TyCon, [Type])
tcSplitTyConApp ty = case tcSplitTyConApp_maybe ty of
| otherwise
= ([], ty)
-tcFunArgTy ty = case tcSplitFunTy_maybe ty of { Just (arg,res) -> arg }
-tcFunResultTy ty = case tcSplitFunTy_maybe ty of { Just (arg,res) -> res }
-
+tcSplitFunTy ty = expectJust "tcSplitFunTy" (tcSplitFunTy_maybe ty)
+tcFunArgTy ty = fst (tcSplitFunTy ty)
+tcFunResultTy ty = snd (tcSplitFunTy ty)
-----------------------
tcSplitAppTy_maybe :: Type -> Maybe (Type, Type)
tcSplitAppTy_maybe ty | Just ty' <- tcView ty = tcSplitAppTy_maybe ty'
-tcSplitAppTy_maybe (FunTy ty1 ty2) = Just (TyConApp funTyCon [ty1], ty2)
-tcSplitAppTy_maybe (AppTy ty1 ty2) = Just (ty1, ty2)
-tcSplitAppTy_maybe (TyConApp tc tys) = case snocView tys of
- Just (tys', ty') -> Just (TyConApp tc tys', ty')
- Nothing -> Nothing
-tcSplitAppTy_maybe other = Nothing
+tcSplitAppTy_maybe ty = repSplitAppTy_maybe ty
+tcSplitAppTy :: Type -> (Type, Type)
tcSplitAppTy ty = case tcSplitAppTy_maybe ty of
Just stuff -> stuff
Nothing -> pprPanic "tcSplitAppTy" (pprType ty)
tcSplitDFunHead tau
= case tcSplitPredTy_maybe tau of
Just (ClassP clas tys) -> (clas, tys)
+ other -> panic "tcSplitDFunHead"
tcValidInstHeadTy :: Type -> Bool
-- Used in Haskell-98 mode, for the argument types of an instance head
getClassPredTys :: PredType -> (Class, [Type])
getClassPredTys (ClassP clas tys) = (clas, tys)
+getClassPredTys other = panic "getClassPredTys"
mkDictTy :: Class -> [Type] -> Type
mkDictTy clas tys = mkPredTy (ClassP clas tys)
isDictTy :: Type -> Bool
isDictTy ty | Just ty' <- tcView ty = isDictTy ty'
-isDictTy (PredTy p) = isClassPred p
-isDictTy other = False
+isDictTy (PredTy p) = isClassPred p
+isDictTy other = False
\end{code}
--------------------- Implicit parameters ---------------------------------
-- which can be free in g's rhs, and shared by both calls to g
isInheritablePred (ClassP _ _) = True
isInheritablePred other = False
+\end{code}
-isLinearPred :: TcPredType -> Bool
-isLinearPred (IParam (Linear n) _) = True
-isLinearPred other = False
+--------------------- Equality predicates ---------------------------------
+\begin{code}
+substEqSpec :: TvSubst -> [(TyVar,Type)] -> [(TcType,TcType)]
+substEqSpec subst eq_spec = [ (substTyVar subst tv, substTy subst ty)
+ | (tv,ty) <- eq_spec]
\end{code}
--------------------- The stupid theta (sigh) ---------------------------------
| con <- cons
, let Just subst = tcMatchTys tvs1 res_tys1 (dataConResTys con)
, pred <- dataConStupidTheta con ]
+dataConsStupidTheta [] = panic "dataConsStupidTheta"
\end{code}
isDoubleTy = is_tc doubleTyConKey
isIntegerTy = is_tc integerTyConKey
isIntTy = is_tc intTyConKey
-isAddrTy = is_tc addrTyConKey
isBoolTy = is_tc boolTyConKey
isUnitTy = is_tc unitTyConKey
\begin{code}
tcTyVarsOfType :: Type -> TcTyVarSet
--- Just the tc type variables free in the type
+-- Just the *TcTyVars* free in the type
+-- (Types.tyVarsOfTypes finds all free TyVars)
tcTyVarsOfType (TyVarTy tv) = if isTcTyVar tv then unitVarSet tv
else emptyVarSet
tcTyVarsOfType (TyConApp tycon tys) = tcTyVarsOfTypes tys
tcTyVarsOfType (PredTy sty) = tcTyVarsOfPred sty
tcTyVarsOfType (FunTy arg res) = tcTyVarsOfType arg `unionVarSet` tcTyVarsOfType res
tcTyVarsOfType (AppTy fun arg) = tcTyVarsOfType fun `unionVarSet` tcTyVarsOfType arg
-tcTyVarsOfType (ForAllTy tyvar ty) = tcTyVarsOfType ty `delVarSet` tyvar
+tcTyVarsOfType (ForAllTy tyvar ty) = (tcTyVarsOfType ty `delVarSet` tyvar)
+ `unionVarSet` tcTyVarsOfTyVar tyvar
-- We do sometimes quantify over skolem TcTyVars
+tcTyVarsOfTyVar :: TcTyVar -> TyVarSet
+tcTyVarsOfTyVar tv | isCoVar tv = tcTyVarsOfType (tyVarKind tv)
+ | otherwise = emptyVarSet
+
tcTyVarsOfTypes :: [Type] -> TyVarSet
tcTyVarsOfTypes tys = foldr (unionVarSet.tcTyVarsOfType) emptyVarSet tys
tcTyVarsOfPred :: PredType -> TyVarSet
-tcTyVarsOfPred (IParam _ ty) = tcTyVarsOfType ty
-tcTyVarsOfPred (ClassP _ tys) = tcTyVarsOfTypes tys
+tcTyVarsOfPred (IParam _ ty) = tcTyVarsOfType ty
+tcTyVarsOfPred (ClassP _ tys) = tcTyVarsOfTypes tys
+tcTyVarsOfPred (EqPred ty1 ty2) = tcTyVarsOfType ty1 `unionVarSet` tcTyVarsOfType ty2
\end{code}
Note [Silly type synonym]
\begin{code}
exactTyVarsOfType :: TcType -> TyVarSet
-- Find the free type variables (of any kind)
--- but *expand* type synonyms. See Note [Silly type synonym] belos.
+-- but *expand* type synonyms. See Note [Silly type synonym] above.
exactTyVarsOfType ty
= go ty
where
go (FunTy arg res) = go arg `unionVarSet` go res
go (AppTy fun arg) = go fun `unionVarSet` go arg
go (ForAllTy tyvar ty) = delVarSet (go ty) tyvar
+ `unionVarSet` go_tv tyvar
+
+ go_pred (IParam _ ty) = go ty
+ go_pred (ClassP _ tys) = exactTyVarsOfTypes tys
+ go_pred (EqPred ty1 ty2) = go ty1 `unionVarSet` go ty2
- go_pred (IParam _ ty) = go ty
- go_pred (ClassP _ tys) = exactTyVarsOfTypes tys
+ go_tv tyvar | isCoVar tyvar = go (tyVarKind tyvar)
+ | otherwise = emptyVarSet
exactTyVarsOfTypes :: [TcType] -> TyVarSet
exactTyVarsOfTypes tys = foldr (unionVarSet . exactTyVarsOfType) emptyVarSet tys
tyClsNamesOfType (NoteTy _ ty2) = tyClsNamesOfType ty2
tyClsNamesOfType (PredTy (IParam n ty)) = tyClsNamesOfType ty
tyClsNamesOfType (PredTy (ClassP cl tys)) = unitNameSet (getName cl) `unionNameSets` tyClsNamesOfTypes tys
+tyClsNamesOfType (PredTy (EqPred ty1 ty2)) = tyClsNamesOfType ty1 `unionNameSets` tyClsNamesOfType ty2
tyClsNamesOfType (FunTy arg res) = tyClsNamesOfType arg `unionNameSets` tyClsNamesOfType res
tyClsNamesOfType (AppTy fun arg) = tyClsNamesOfType fun `unionNameSets` tyClsNamesOfType arg
tyClsNamesOfType (ForAllTy tyvar ty) = tyClsNamesOfType ty
isFFIDynArgumentTy :: Type -> Bool
-- The argument type of a foreign import dynamic must be Ptr, FunPtr, Addr,
-- or a newtype of either.
-isFFIDynArgumentTy = checkRepTyConKey [ptrTyConKey, funPtrTyConKey, addrTyConKey]
+isFFIDynArgumentTy = checkRepTyConKey [ptrTyConKey, funPtrTyConKey]
isFFIDynResultTy :: Type -> Bool
-- The result type of a foreign export dynamic must be Ptr, FunPtr, Addr,
-- or a newtype of either.
-isFFIDynResultTy = checkRepTyConKey [ptrTyConKey, funPtrTyConKey, addrTyConKey]
+isFFIDynResultTy = checkRepTyConKey [ptrTyConKey, funPtrTyConKey]
isFFILabelTy :: Type -> Bool
-- The type of a foreign label must be Ptr, FunPtr, Addr,
-- or a newtype of either.
-isFFILabelTy = checkRepTyConKey [ptrTyConKey, funPtrTyConKey, addrTyConKey]
+isFFILabelTy = checkRepTyConKey [ptrTyConKey, funPtrTyConKey]
isFFIDotnetTy :: DynFlags -> Type -> Bool
isFFIDotnetTy dflags ty
toDNType ty
| isStringTy ty = DNString
| isFFIDotnetObjTy ty = DNObject
- | Just (tc,argTys) <- tcSplitTyConApp_maybe ty =
- case lookup (getUnique tc) dn_assoc of
+ | Just (tc,argTys) <- tcSplitTyConApp_maybe ty
+ = case lookup (getUnique tc) dn_assoc of
Just x -> x
Nothing
| tc `hasKey` ioTyConKey -> toDNType (head argTys)
- | otherwise -> pprPanic ("toDNType: unsupported .NET type") (pprType ty <+> parens (hcat (map pprType argTys)) <+> ppr tc)
+ | otherwise -> pprPanic ("toDNType: unsupported .NET type")
+ (pprType ty <+> parens (hcat (map pprType argTys)) <+> ppr tc)
+ | otherwise = panic "toDNType" -- Is this right?
where
dn_assoc :: [ (Unique, DNType) ]
dn_assoc = [ (unitTyConKey, DNUnit)
, (word64TyConKey, DNWord64)
, (floatTyConKey, DNFloat)
, (doubleTyConKey, DNDouble)
- , (addrTyConKey, DNPtr)
, (ptrTyConKey, DNPtr)
, (funPtrTyConKey, DNPtr)
, (charTyConKey, DNChar)
, wordTyConKey, word8TyConKey, word16TyConKey
, word32TyConKey, word64TyConKey
, floatTyConKey, doubleTyConKey
- , addrTyConKey, ptrTyConKey, funPtrTyConKey
+ , ptrTyConKey, funPtrTyConKey
, charTyConKey
, stablePtrTyConKey
, boolTyConKey
projects / ghc-hetmet.git / blobdiff