[project @ 2001-04-30 10:50:00 by simonpj]

[ghc-hetmet.git] / ghc / compiler / typecheck / TcMonad.lhs

diff --git a/ghc/compiler/typecheck/TcMonad.lhs b/ghc/compiler/typecheck/TcMonad.lhs
index 3e3322e..acbfd15 100644 (file)
--- 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
@@ -244,7 +250,7 @@ which is a Royal Pain.  By the time this fork stuff is used they'll
 have been unified down so there won't be any kind variables, but we
 can't express that in the current typechecker framework.
 
-So we compromise and use unsafeInterleaveSST.
+So we compromise and use unsafeInterleaveIO.
 
 We throw away any error messages!
 
@@ -268,7 +274,9 @@ forkNF_Tc m down@(TcDown { tc_us = u_var }) env
 
 \begin{code}
 traceTc :: SDoc -> NF_TcM ()
-traceTc doc down env = printDump doc
+traceTc doc (TcDown { tc_dflags=dflags }) env 
+  | dopt Opt_D_dump_tc_trace dflags = printDump doc
+  | otherwise                      = return ()
 
 ioToTc :: IO a -> NF_TcM a
 ioToTc io down env = io
@@ -668,7 +676,7 @@ data InstOrigin
 
   | InstanceDeclOrigin         -- Typechecking an instance decl
 
-  | LiteralOrigin RenamedHsOverLit     -- Occurrence of a literal
+  | LiteralOrigin HsOverLit    -- Occurrence of a literal
 
   | PatOrigin RenamedPat