[project @ 2001-05-04 08:10:30 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 b13a511..c0fb587 100644 (file)
--- a/ghc/compiler/typecheck/TcMonad.lhs
+++ b/ghc/compiler/typecheck/TcMonad.lhs
@@ -47,7 +47,8 @@ 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 )
@@ -93,11 +94,11 @@ 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 TcPredType  = PredType
-type TcThetaType = ThetaType
-type TcRhoType   = RhoType
-type TcTauType   = TauType
-type TcKind      = TcType
+type TcPredType     = PredType
+type TcThetaType    = ThetaType
+type TcRhoType      = RhoType
+type TcTauType      = TauType
+type TcKind         = TcType
 \end{code}
 
 
@@ -216,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
@@ -243,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!
 
@@ -267,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
@@ -658,13 +667,16 @@ type InstLoc = (InstOrigin, SrcLoc, ErrCtxt)
 data InstOrigin
   = OccurrenceOf Id            -- Occurrence of an overloaded identifier
 
+  | IPOcc Name                 -- Occurrence of an implicit parameter
+  | IPBind Name                        -- Binding site of an implicit parameter
+
   | RecordUpdOrigin
 
   | DataDeclOrigin             -- Typechecking a data declaration
 
   | InstanceDeclOrigin         -- Typechecking an instance decl
 
-  | LiteralOrigin RenamedHsOverLit     -- Occurrence of a literal
+  | LiteralOrigin HsOverLit    -- Occurrence of a literal
 
   | PatOrigin RenamedPat
 
@@ -709,12 +721,16 @@ pprInstLoc (orig, locn, ctxt)
   where
     pp_orig (OccurrenceOf id)
        = hsep [ptext SLIT("use of"), quotes (ppr id)]
+    pp_orig (IPOcc name)
+       = hsep [ptext SLIT("use of implicit parameter"), quotes (char '?' <> ppr name)]
+    pp_orig (IPBind name)
+       = hsep [ptext SLIT("binding for implicit parameter"), quotes (char '?' <> ppr name)]
     pp_orig (LiteralOrigin lit)
        = hsep [ptext SLIT("the literal"), quotes (ppr lit)]
     pp_orig (PatOrigin pat)
        = hsep [ptext SLIT("the pattern"), quotes (ppr pat)]
     pp_orig (InstanceDeclOrigin)
-       =  ptext SLIT("an instance declaration")
+       =  ptext SLIT("the instance declaration")
     pp_orig (ArithSeqOrigin seq)
        = hsep [ptext SLIT("the arithmetic sequence"), quotes (ppr seq)]
     pp_orig (SignatureOrigin)