[project @ 2003-06-27 21:17:24 by simonpj]
[ghc-hetmet.git] / ghc / compiler / typecheck / TcMonoType.lhs
index 320cf8d..c257251 100644 (file)
@@ -19,7 +19,7 @@ module TcMonoType ( tcHsSigType, tcHsType, tcIfaceType, tcHsTheta, tcHsPred,
 #include "HsVersions.h"
 
 import HsSyn           ( HsType(..), HsTyVarBndr(..), HsTyOp(..),
-                          Sig(..), HsPred(..), pprParendHsType, HsTupCon(..), hsTyVarNames )
+                          Sig(..), HsPred(..), HsTupCon(..), hsTyVarNames )
 import RnHsSyn         ( RenamedHsType, RenamedHsPred, RenamedContext, RenamedSig, extractHsTyVars )
 import TcHsSyn         ( TcId )
 
@@ -31,14 +31,14 @@ import TcEnv                ( tcExtendTyVarEnv, tcLookup, tcLookupGlobal,
 import TcMType         ( newMutTyVar, newKindVar, zonkKindEnv, tcInstType, zonkTcType,
                          checkValidType, UserTypeCtxt(..), pprUserTypeCtxt, newOpenTypeKind
                        )
-import TcUnify         ( unifyKind, unifyOpenTypeKind, unifyFunKind )
+import TcUnify         ( unifyKind, unifyFunKind )
 import TcType          ( Type, Kind, SourceType(..), ThetaType, TyVarDetails(..),
                          TcTyVar, TcKind, TcThetaType, TcTauType,
                          mkTyVarTy, mkTyVarTys, mkFunTy, isTypeKind,
                          zipFunTys, mkForAllTys, mkFunTys, tcEqType, isPredTy,
                          mkSigmaTy, mkPredTy, mkGenTyConApp, mkTyConApp, mkAppTys, 
-                         liftedTypeKind, unliftedTypeKind, mkArrowKind, eqKind,
-                         mkArrowKinds, tcSplitFunTy_maybe, tcSplitForAllTys
+                         liftedTypeKind, unliftedTypeKind, eqKind,
+                         tcSplitFunTy_maybe, tcSplitForAllTys
                        )
 import qualified Type  ( splitFunTys )
 import Inst            ( Inst, InstOrigin(..), newMethod, instToId )
@@ -654,13 +654,13 @@ maybeSig (sig@(TySigInfo sig_id _ _ _ _ _ _) : sigs) name
 tcTySig :: RenamedSig -> TcM TcSigInfo
 
 tcTySig (Sig v ty src_loc)
- = addSrcLoc src_loc                           $ 
-   tcHsSigType (FunSigCtxt v) ty               `thenM` \ sigma_tc_ty ->
-   mkTcSig (mkLocalId v sigma_tc_ty) src_loc   `thenM` \ sig -> 
+ = addSrcLoc src_loc                   $ 
+   tcHsSigType (FunSigCtxt v) ty       `thenM` \ sigma_tc_ty ->
+   mkTcSig (mkLocalId v sigma_tc_ty)   `thenM` \ sig -> 
    returnM sig
 
-mkTcSig :: TcId -> SrcLoc -> TcM TcSigInfo
-mkTcSig poly_id src_loc
+mkTcSig :: TcId -> TcM TcSigInfo
+mkTcSig poly_id
   =    -- Instantiate this type
        -- It's important to do this even though in the error-free case
        -- we could just split the sigma_tc_ty (since the tyvars don't
@@ -677,6 +677,7 @@ mkTcSig poly_id src_loc
        -- We make a Method even if it's not overloaded; no harm
        -- But do not extend the LIE!  We're just making an Id.
        
+   getSrcLocM                                  `thenM` \ src_loc ->
    returnM (TySigInfo poly_id tyvars' theta' tau' 
                          (instToId inst) [inst] src_loc)
 \end{code}
@@ -761,10 +762,11 @@ appKindCtxt pp = ptext SLIT("When checking kinds in") <+> quotes pp
 wrongThingErr expected thing name
   = pp_thing thing <+> quotes (ppr name) <+> ptext SLIT("used as a") <+> text expected
   where
-    pp_thing (AGlobal (ATyCon _)) = ptext SLIT("Type constructor")
-    pp_thing (AGlobal (AClass _)) = ptext SLIT("Class")
-    pp_thing (AGlobal (AnId   _)) = ptext SLIT("Identifier")
+    pp_thing (AGlobal (ATyCon _))   = ptext SLIT("Type constructor")
+    pp_thing (AGlobal (AClass _))   = ptext SLIT("Class")
+    pp_thing (AGlobal (AnId   _))   = ptext SLIT("Identifier")
+    pp_thing (AGlobal (ADataCon _)) = ptext SLIT("Data constructor")
     pp_thing (ATyVar _)          = ptext SLIT("Type variable")
-    pp_thing (ATcId _ _)         = ptext SLIT("Local identifier")
+    pp_thing (ATcId _ _ _)       = ptext SLIT("Local identifier")
     pp_thing (AThing _)          = ptext SLIT("Utterly bogus")
 \end{code}