[project @ 2001-11-19 16:34:12 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 8b484a3..d613e07 100644 (file)
--- a/ghc/compiler/typecheck/TcMonad.lhs
+++ b/ghc/compiler/typecheck/TcMonad.lhs
@@ -1,8 +1,5 @@
 \begin{code}
 module TcMonad(
-       TcType, TcTauType, TcPredType, TcThetaType, TcRhoType,
-       TcTyVar, TcTyVarSet, TcKind,
-
        TcM, NF_TcM, TcDown, TcEnv, 
 
        initTc,
@@ -32,7 +29,7 @@ module TcMonad(
        tcAddErrCtxtM, tcSetErrCtxtM,
        tcAddErrCtxt, tcSetErrCtxt, tcPopErrCtxt,
 
-       tcNewMutVar, tcNewSigTyVar, tcReadMutVar, tcWriteMutVar, TcRef,
+       tcNewMutVar, tcReadMutVar, tcWriteMutVar, TcRef,
        tcNewMutTyVar, tcReadMutTyVar, tcWriteMutTyVar,
 
        InstOrigin(..), InstLoc, pprInstLoc, 
@@ -47,16 +44,15 @@ import {-# SOURCE #-} TcEnv  ( TcEnv )
 
 import HsLit           ( HsOverLit )
 import RnHsSyn         ( RenamedPat, RenamedArithSeqInfo, RenamedHsExpr )
-import TcType          ( Type, Kind, PredType, ThetaType, TauType, RhoType )
+import TcType          ( Type, Kind, TyVarDetails )
 import ErrUtils                ( addShortErrLocLine, addShortWarnLocLine, ErrMsg, Message, WarnMsg )
 
 import Bag             ( Bag, emptyBag, isEmptyBag,
                          foldBag, unitBag, unionBags, snocBag )
 import Class           ( Class )
 import Name            ( Name )
-import Var             ( Id, TyVar, newMutTyVar, newSigTyVar, readMutTyVar, writeMutTyVar )
+import Var             ( Id, TyVar, newMutTyVar, readMutTyVar, writeMutTyVar )
 import VarEnv          ( TidyEnv, emptyTidyEnv )
-import VarSet          ( TyVarSet )
 import UniqSupply      ( UniqSupply, uniqFromSupply, uniqsFromSupply, 
                          splitUniqSupply, mkSplitUniqSupply,
                          UniqSM, initUs_ )
@@ -77,30 +73,6 @@ infixr 9 `thenTc`, `thenTc_`, `thenNF_Tc`, `thenNF_Tc_`
 
 %************************************************************************
 %*                                                                     *
-\subsection{Types}
-%*                                                                     *
-%************************************************************************
-
-\begin{code}
-type TcTyVar    = TyVar                -- Might be a mutable tyvar
-type TcTyVarSet = TyVarSet
-
-type TcType = Type             -- A TcType can have mutable type variables
-       -- Invariant on ForAllTy in TcTypes:
-       --      forall a. T
-       -- 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
-\end{code}
-
-
-%************************************************************************
-%*                                                                     *
 \subsection{The main monads: TcM, NF_TcM}
 %*                                                                     *
 %************************************************************************
@@ -295,7 +267,7 @@ failTc :: TcM a
 failTc down env = give_up
 
 give_up :: IO a
-give_up = IOERROR (userError "Typecheck failed")
+give_up = ioError (userError "Typecheck failed")
 
 failWithTc :: Message -> TcM a                 -- Add an error message and fail
 failWithTc err_msg = failWithTcM (emptyTidyEnv, err_msg)
@@ -469,11 +441,8 @@ tcWriteMutVar var val down env = writeIORef var val
 tcReadMutVar :: TcRef a -> NF_TcM a
 tcReadMutVar var down env = readIORef var
 
-tcNewMutTyVar :: Name -> Kind -> NF_TcM TyVar
-tcNewMutTyVar name kind down env = newMutTyVar name kind
-
-tcNewSigTyVar :: Name -> Kind -> NF_TcM TyVar
-tcNewSigTyVar name kind down env = newSigTyVar name kind
+tcNewMutTyVar :: Name -> Kind -> TyVarDetails -> NF_TcM TyVar
+tcNewMutTyVar name kind details down env = newMutTyVar name kind details
 
 tcReadMutTyVar :: TyVar -> NF_TcM (Maybe Type)
 tcReadMutTyVar tyvar down env = readMutTyVar tyvar
@@ -642,12 +611,7 @@ type TcError   = Message
 type TcWarning = Message
 
 ctxt_to_use ctxt | opt_PprStyle_Debug = ctxt
-                | otherwise          = takeAtMost 3 ctxt
-                where
-                  takeAtMost :: Int -> [a] -> [a]
-                  takeAtMost 0 ls = []
-                  takeAtMost n [] = []
-                  takeAtMost n (x:xs) = x:takeAtMost (n-1) xs
+                | otherwise          = take 3 ctxt
 
 arityErr kind name n m
   = hsep [ text kind, quotes (ppr name), ptext SLIT("should have"),
@@ -737,12 +701,16 @@ pprInstLoc (orig, locn, ctxt)
        = 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 RecordUpdOrigin
+       = ptext SLIT("a record update")
+    pp_orig DataDeclOrigin
+       = ptext SLIT("the data type declaration")
+    pp_orig InstanceDeclOrigin
+       = ptext SLIT("the instance declaration")
     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("the instance declaration")
     pp_orig (ArithSeqOrigin seq)
        = hsep [ptext SLIT("the arithmetic sequence"), quotes (ppr seq)]
     pp_orig (SignatureOrigin)