[project @ 2002-04-01 08:23: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 6241d1c..de83f05 100644 (file)
--- a/ghc/compiler/typecheck/TcMonad.lhs
+++ b/ghc/compiler/typecheck/TcMonad.lhs
@@ -44,19 +44,20 @@ import {-# SOURCE #-} TcEnv  ( TcEnv )
 
 import HsLit           ( HsOverLit )
 import RnHsSyn         ( RenamedPat, RenamedArithSeqInfo, RenamedHsExpr )
-import TcType          ( Type, Kind, TyVarDetails, IPName )
+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, readMutTyVar, writeMutTyVar )
+import Var             ( TyVar, newMutTyVar, readMutTyVar, writeMutTyVar )
 import VarEnv          ( TidyEnv, emptyTidyEnv )
-import UniqSupply      ( UniqSupply, uniqFromSupply, uniqsFromSupply, 
+import UniqSupply      ( UniqSupply, uniqFromSupply, uniqsFromSupply,
                          splitUniqSupply, mkSplitUniqSupply,
                          UniqSM, initUs_ )
 import SrcLoc          ( SrcLoc, noSrcLoc )
+import BasicTypes      ( IPName )
 import UniqFM          ( emptyUFM )
 import Unique          ( Unique )
 import CmdLineOpts
@@ -589,11 +590,11 @@ popErrCtxt down = case tc_ctxt down of
                        []     -> down
                        m : ms -> down{tc_ctxt = ms}
 
-doptsTc :: DynFlag -> TcM Bool
+doptsTc :: DynFlag -> NF_TcM Bool
 doptsTc dflag (TcDown{tc_dflags=dflags}) env_down
    = return (dopt dflag dflags)
 
-getDOptsTc :: TcM DynFlags
+getDOptsTc :: NF_TcM DynFlags
 getDOptsTc (TcDown{tc_dflags=dflags}) env_down
    = return dflags
 \end{code}
@@ -642,7 +643,7 @@ functions that deal with it.
 type InstLoc = (InstOrigin, SrcLoc, ErrCtxt)
 
 data InstOrigin
-  = OccurrenceOf Id            -- Occurrence of an overloaded identifier
+  = OccurrenceOf Name          -- Occurrence of an overloaded identifier
 
   | IPOcc (IPName Name)                -- Occurrence of an implicit parameter
   | IPBind (IPName Name)       -- Binding site of an implicit parameter
@@ -658,6 +659,7 @@ data InstOrigin
   | PatOrigin RenamedPat
 
   | ArithSeqOrigin RenamedArithSeqInfo -- [x..], [x..y] etc
+  | PArrSeqOrigin  RenamedArithSeqInfo -- [:x..y:] and [:x,y..z:]
 
   | SignatureOrigin            -- A dict created from a type signature
   | Rank2Origin                        -- A dict created when typechecking the argument
@@ -696,12 +698,12 @@ pprInstLoc :: InstLoc -> SDoc
 pprInstLoc (orig, locn, ctxt)
   = hsep [text "arising from", pp_orig orig, text "at", ppr locn]
   where
-    pp_orig (OccurrenceOf id)
-       = hsep [ptext SLIT("use of"), quotes (ppr id)]
+    pp_orig (OccurrenceOf name)
+       = hsep [ptext SLIT("use of"), quotes (ppr name)]
     pp_orig (IPOcc name)
-       = hsep [ptext SLIT("use of implicit parameter"), quotes (char '?' <> ppr name)]
+       = hsep [ptext SLIT("use of implicit parameter"), quotes (ppr name)]
     pp_orig (IPBind name)
-       = hsep [ptext SLIT("binding for implicit parameter"), quotes (char '?' <> ppr name)]
+       = hsep [ptext SLIT("binding for implicit parameter"), quotes (ppr name)]
     pp_orig RecordUpdOrigin
        = ptext SLIT("a record update")
     pp_orig DataDeclOrigin
@@ -714,6 +716,8 @@ pprInstLoc (orig, locn, ctxt)
        = hsep [ptext SLIT("the pattern"), quotes (ppr pat)]
     pp_orig (ArithSeqOrigin seq)
        = hsep [ptext SLIT("the arithmetic sequence"), quotes (ppr seq)]
+    pp_orig (PArrSeqOrigin seq)
+       = hsep [ptext SLIT("the parallel array sequence"), quotes (ppr seq)]
     pp_orig (SignatureOrigin)
        =  ptext SLIT("a type signature")
     pp_orig (Rank2Origin)