X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypecheck%2FTcMonoType.lhs;h=d933c2f85bd33d5ec9da7379e062c34300978a95;hb=f7ecf7234c224489be8a5e63fced903b655d92ee;hp=bd27cbdf4daa2645289b3bdee11d4a8286f2c3ec;hpb=f9120c200bcf613b58d742802172fb4c08171f0d;p=ghc-hetmet.git diff --git a/ghc/compiler/typecheck/TcMonoType.lhs b/ghc/compiler/typecheck/TcMonoType.lhs index bd27cbd..d933c2f 100644 --- a/ghc/compiler/typecheck/TcMonoType.lhs +++ b/ghc/compiler/typecheck/TcMonoType.lhs @@ -8,15 +8,15 @@ module TcMonoType ( tcPolyType, tcMonoType, tcMonoTypeKind, tcContext ) where -import Ubiq{-uitous-} +IMP_Ubiq(){-uitous-} import HsSyn ( PolyType(..), MonoType(..), Fake ) import RnHsSyn ( RenamedPolyType(..), RenamedMonoType(..), - RenamedContext(..), RnName(..) + RenamedContext(..), RnName(..), + isRnLocal, isRnClass, isRnTyCon ) - -import TcMonad +import TcMonad hiding ( rnMtoTcM ) import TcEnv ( tcLookupTyVar, tcLookupClass, tcLookupTyCon, tcTyVarScope, tcTyVarScopeGivenKinds ) @@ -24,22 +24,18 @@ import TcKind ( TcKind, mkTcTypeKind, mkBoxedTypeKind, mkTcArrowKind, unifyKind, newKindVar, kindToTcKind ) -import Type ( GenType, Type(..), ThetaType(..), +import Type ( GenType, SYN_IE(Type), SYN_IE(ThetaType), mkTyVarTy, mkTyConTy, mkFunTy, mkAppTy, mkSynTy, - mkSigmaTy + mkSigmaTy, mkDictTy ) -import TyVar ( GenTyVar, TyVar(..), mkTyVar ) -import PrelInfo ( mkListTy, mkTupleTy ) -import Type ( mkDictTy ) +import TyVar ( GenTyVar, SYN_IE(TyVar) ) import Class ( cCallishClassKeys ) -import TyCon ( TyCon, Arity(..) ) +import TyCon ( TyCon ) +import TysWiredIn ( mkListTy, mkTupleTy ) import Unique ( Unique ) import PprStyle import Pretty -import RnHsSyn ( isRnLocal, isRnClass, isRnTyCon, - RnName{-instance NamedThing-} - ) -import Util ( zipWithEqual, panic ) +import Util ( zipWithEqual, panic{-, pprPanic ToDo:rm-} ) \end{code} @@ -85,12 +81,14 @@ tcMonoTypeKind (MonoTyApp name tys) = tcLookupTyVar name `thenNF_Tc` \ (kind,tyvar) -> tcMonoTyApp kind (mkTyVarTy tyvar) tys -tcMonoTypeKind (MonoTyApp name tys) - | isRnTyCon name -- Must be a type constructor + | otherwise {-isRnTyCon name-} -- Must be a type constructor = tcLookupTyCon name `thenNF_Tc` \ (kind,maybe_arity,tycon) -> case maybe_arity of Just arity -> tcSynApp name kind arity tycon tys -- synonum Nothing -> tcMonoTyApp kind (mkTyConTy tycon) tys -- newtype or data + +-- | otherwise +-- = pprPanic "tcMonoTypeKind:" (ppr PprDebug name) -- for unfoldings only: tcMonoTypeKind (MonoForAllTy tyvars_w_kinds ty) @@ -155,10 +153,10 @@ tcClassAssertion (class_name, tyvar_name) returnTc (clas, mkTyVarTy tyvar) \end{code} -HACK warning: Someone discovered that @_CCallable@ and @_CReturnable@ +HACK warning: Someone discovered that @CCallable@ and @CReturnable@ could be used in contexts such as: \begin{verbatim} -foo :: _CCallable a => a -> PrimIO Int +foo :: CCallable a => a -> PrimIO Int \end{verbatim} Doing this utterly wrecks the whole point of introducing these