X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypecheck%2FTcMonad.lhs;h=acbfd15080cd44ed2506da95efcf7d1d244cf9cb;hb=55d04fc7a6fbd58358f284bd84648dad09046f60;hp=504f5dabf6ac6655cfc6414333d46d708bb379f4;hpb=ade2eac4257679a3ac152a39df87ce8567bd7766;p=ghc-hetmet.git diff --git a/ghc/compiler/typecheck/TcMonad.lhs b/ghc/compiler/typecheck/TcMonad.lhs index 504f5da..acbfd15 100644 --- a/ghc/compiler/typecheck/TcMonad.lhs +++ b/ghc/compiler/typecheck/TcMonad.lhs @@ -2,7 +2,7 @@ module TcMonad( TcType, TcTauType, TcPredType, TcThetaType, TcRhoType, - TcTyVar, TcTyVarSet, TcClassContext, + TcTyVar, TcTyVarSet, TcKind, TcM, NF_TcM, TcDown, TcEnv, @@ -47,14 +47,15 @@ module TcMonad( import {-# SOURCE #-} TcEnv ( TcEnv ) -import RnHsSyn ( RenamedPat, RenamedArithSeqInfo, RenamedHsExpr, RenamedHsOverLit ) +import HsSyn ( HsOverLit ) +import RnHsSyn ( RenamedPat, RenamedArithSeqInfo, RenamedHsExpr ) import Type ( Type, Kind, PredType, ThetaType, RhoType, TauType, ) import ErrUtils ( addShortErrLocLine, addShortWarnLocLine, ErrMsg, Message, WarnMsg ) import Bag ( Bag, emptyBag, isEmptyBag, foldBag, unitBag, unionBags, snocBag ) -import Class ( Class, ClassContext ) +import Class ( Class ) import Name ( Name ) import Var ( Id, TyVar, newMutTyVar, newSigTyVar, readMutTyVar, writeMutTyVar ) import VarEnv ( TidyEnv, emptyTidyEnv ) @@ -93,7 +94,6 @@ type TcType = Type -- A TcType can have mutable type variables -- a cannot occur inside a MutTyVar in T; that is, -- T is "flattened" before quantifying over a -type TcClassContext = ClassContext type TcPredType = PredType type TcThetaType = ThetaType type TcRhoType = RhoType @@ -217,6 +217,12 @@ mapBagTc f bag fixTc :: (a -> TcM a) -> TcM a fixNF_Tc :: (a -> NF_TcM a) -> NF_TcM a fixTc m env down = fixIO (\ loop -> m loop env down) +{-# NOINLINE fixTc #-} +-- aargh! Not inlining fixTc alleviates a space leak problem. +-- Normally fixTc is used with a lazy tuple match: if the optimiser is +-- shown the definition of fixTc, it occasionally transforms the code +-- in such a way that the code generator doesn't spot the selector +-- thunks. Sigh. recoverTc :: TcM r -> TcM r -> TcM r recoverNF_Tc :: NF_TcM r -> TcM r -> NF_TcM r @@ -269,7 +275,7 @@ forkNF_Tc m down@(TcDown { tc_us = u_var }) env \begin{code} traceTc :: SDoc -> NF_TcM () traceTc doc (TcDown { tc_dflags=dflags }) env - | dopt Opt_D_dump_rn_trace dflags = printDump doc + | dopt Opt_D_dump_tc_trace dflags = printDump doc | otherwise = return () ioToTc :: IO a -> NF_TcM a @@ -670,7 +676,7 @@ data InstOrigin | InstanceDeclOrigin -- Typechecking an instance decl - | LiteralOrigin RenamedHsOverLit -- Occurrence of a literal + | LiteralOrigin HsOverLit -- Occurrence of a literal | PatOrigin RenamedPat