[project @ 1999-07-27 07:31:16 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 d3f1ee1..27abfa7 100644 (file)
--- a/ghc/compiler/typecheck/TcMonad.lhs
+++ b/ghc/compiler/typecheck/TcMonad.lhs
@@ -32,7 +32,7 @@ module TcMonad(
        tcAddErrCtxtM, tcSetErrCtxtM,
        tcAddErrCtxt, tcSetErrCtxt,
 
-       tcNewMutVar, tcReadMutVar, tcWriteMutVar, TcRef,
+       tcNewMutVar, tcNewSigTyVar, tcReadMutVar, tcWriteMutVar, TcRef,
        tcNewMutTyVar, tcReadMutTyVar, tcWriteMutTyVar,
 
        TcError, TcWarning, TidyEnv, emptyTidyEnv,
@@ -52,11 +52,11 @@ import Bag          ( Bag, emptyBag, isEmptyBag,
                          foldBag, unitBag, unionBags, snocBag )
 import Class           ( Class )
 import Name            ( Name )
-import Var             ( TyVar, newMutTyVar, readMutTyVar, writeMutTyVar )
+import Var             ( TyVar, newMutTyVar, newSigTyVar, readMutTyVar, writeMutTyVar )
 import VarEnv          ( TyVarEnv, emptyVarEnv, TidyEnv, emptyTidyEnv )
 import VarSet          ( TyVarSet )
 import UniqSupply      ( UniqSupply, uniqFromSupply, uniqsFromSupply, splitUniqSupply,
-                         UniqSM, initUs )
+                         UniqSM, initUs_ )
 import SrcLoc          ( SrcLoc, noSrcLoc )
 import FiniteMap       ( FiniteMap, emptyFM )
 import UniqFM          ( UniqFM, emptyUFM )
@@ -281,7 +281,7 @@ failTc :: TcM s a
 failTc down env = give_up
 
 give_up :: IO a
-give_up = fail (userError "Typecheck failed")
+give_up = IOERROR (userError "Typecheck failed")
 
 failWithTc :: Message -> TcM s a                       -- Add an error message and fail
 failWithTc err_msg = failWithTcM (emptyTidyEnv, err_msg)
@@ -430,6 +430,9 @@ tcReadMutVar var down env = readIORef var
 tcNewMutTyVar :: Name -> Kind -> NF_TcM s TyVar
 tcNewMutTyVar name kind down env = newMutTyVar name kind
 
+tcNewSigTyVar :: Name -> Kind -> NF_TcM s TyVar
+tcNewSigTyVar name kind down env = newSigTyVar name kind
+
 tcReadMutTyVar :: TyVar -> NF_TcM s (Maybe Type)
 tcReadMutTyVar tyvar down env = readMutTyVar tyvar
 
@@ -504,7 +507,7 @@ uniqSMToTcM m down env
   = do uniq_supply <- readIORef u_var
        let (new_uniq_supply, uniq_s) = splitUniqSupply uniq_supply
        writeIORef u_var new_uniq_supply
-       return (initUs uniq_s m)
+       return (initUs_ uniq_s m)
   where
     u_var = getUniqSupplyVar down
 \end{code}