(F)SLIT -> (f)sLit in TcMatches

[ghc-hetmet.git] / compiler / typecheck / TcBinds.lhs

diff --git a/compiler/typecheck/TcBinds.lhs b/compiler/typecheck/TcBinds.lhs
index bf9d922..3b9a496 100644 (file)
--- a/compiler/typecheck/TcBinds.lhs
+++ b/compiler/typecheck/TcBinds.lhs
@@ -5,11 +5,11 @@
 \section[TcBinds]{TcBinds}
 
 \begin{code}
 \section[TcBinds]{TcBinds}
 
 \begin{code}

-{-# OPTIONS_GHC -w #-}
+{-# OPTIONS -w #-}

 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and fix
 -- any warnings in the module. See
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and fix
 -- any warnings in the module. See

---     http://hackage.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings
+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings

 -- for details
 
 module TcBinds ( tcLocalBinds, tcTopBinds, 
 -- for details
 
 module TcBinds ( tcLocalBinds, tcTopBinds, 

@@ -18,8 +18,6 @@ module TcBinds ( tcLocalBinds, tcTopBinds,
                 TcSigInfo(..), TcSigFun, mkTcSigFun,
                 badBootDeclErr ) where
 
                 TcSigInfo(..), TcSigFun, mkTcSigFun,
                 badBootDeclErr ) where
 

-#include "HsVersions.h"
-

 import {-# SOURCE #-} TcMatches ( tcGRHSsPat, tcMatchesFun )
 import {-# SOURCE #-} TcExpr  ( tcMonoExpr )
 
 import {-# SOURCE #-} TcMatches ( tcGRHSsPat, tcMatchesFun )
 import {-# SOURCE #-} TcExpr  ( tcMonoExpr )
 

@@ -42,7 +40,7 @@ import VarEnv
 import TysPrim
 import Id
 import IdInfo
 import TysPrim
 import Id
 import IdInfo

-import Var ( TyVar )
+import Var ( TyVar, varType )

 import Name
 import NameSet
 import NameEnv
 import Name
 import NameSet
 import NameEnv

@@ -56,6 +54,9 @@ import List
 import Util
 import BasicTypes
 import Outputable
 import Util
 import BasicTypes
 import Outputable

+import FastString
+
+import Control.Monad

 \end{code}
 
 
 \end{code}
 
 

@@ -115,7 +116,7 @@ tcHsBootSigs (ValBindsOut binds sigs)
 tcHsBootSigs groups = pprPanic "tcHsBootSigs" (ppr groups)
 
 badBootDeclErr :: Message
 tcHsBootSigs groups = pprPanic "tcHsBootSigs" (ppr groups)
 
 badBootDeclErr :: Message

-badBootDeclErr = ptext SLIT("Illegal declarations in an hs-boot file")
+badBootDeclErr = ptext (sLit "Illegal declarations in an hs-boot file")

 
 ------------------------
 tcLocalBinds :: HsLocalBinds Name -> TcM thing
 
 ------------------------
 tcLocalBinds :: HsLocalBinds Name -> TcM thing

@@ -141,11 +142,11 @@ tcLocalBinds (HsIPBinds (IPBinds ip_binds _)) thing_inside
        -- I wonder if we should do these one at at time
        -- Consider     ?x = 4
        --              ?y = ?x + 1
        -- I wonder if we should do these one at at time
        -- Consider     ?x = 4
        --              ?y = ?x + 1

-    tc_ip_bind (IPBind ip expr)
-      = newFlexiTyVarTy argTypeKind            `thenM` \ ty ->
-       newIPDict (IPBindOrigin ip) ip ty       `thenM` \ (ip', ip_inst) ->
-       tcMonoExpr expr ty                      `thenM` \ expr' ->
-       returnM (ip_inst, (IPBind ip' expr'))
+    tc_ip_bind (IPBind ip expr) = do
+        ty <- newFlexiTyVarTy argTypeKind
+        (ip', ip_inst) <- newIPDict (IPBindOrigin ip) ip ty
+        expr' <- tcMonoExpr expr ty
+        return (ip_inst, (IPBind ip' expr'))

 
 ------------------------
 tcValBinds :: TopLevelFlag 
 
 ------------------------
 tcValBinds :: TopLevelFlag 

@@ -313,8 +314,8 @@ tcPolyBinds top_lvl sig_fn prag_fn rec_group rec_tc binds
     setSrcSpan loc                             $
     recoverM (recoveryCode binder_names sig_fn)        $ do 
 
     setSrcSpan loc                             $
     recoverM (recoveryCode binder_names sig_fn)        $ do 
 

-  { traceTc (ptext SLIT("------------------------------------------------"))
-  ; traceTc (ptext SLIT("Bindings for") <+> ppr binder_names)
+  { traceTc (ptext (sLit "------------------------------------------------"))
+  ; traceTc (ptext (sLit "Bindings for") <+> ppr binder_names)

 
        -- TYPECHECK THE BINDINGS
   ; ((binds', mono_bind_infos), lie_req) 
 
        -- TYPECHECK THE BINDINGS
   ; ((binds', mono_bind_infos), lie_req) 

@@ -344,15 +345,15 @@ tcPolyBinds top_lvl sig_fn prag_fn rec_group rec_tc binds
           generalise dflags top_lvl bind_list sig_fn mono_bind_infos lie_req
 
        -- BUILD THE POLYMORPHIC RESULT IDs
           generalise dflags top_lvl bind_list sig_fn mono_bind_infos lie_req
 
        -- BUILD THE POLYMORPHIC RESULT IDs

-  ; let dict_ids = map instToId dicts
-  ; exports <- mapM (mkExport top_lvl prag_fn tyvars_to_gen (map idType dict_ids))
+  ; let dict_vars = map instToVar dicts        -- May include equality constraints
+  ; exports <- mapM (mkExport top_lvl prag_fn tyvars_to_gen (map varType dict_vars))

                    mono_bind_infos
 
   ; let        poly_ids = [poly_id | (_, poly_id, _, _) <- exports]
   ; traceTc (text "binding:" <+> ppr (poly_ids `zip` map idType poly_ids))
 
   ; let abs_bind = L loc $ AbsBinds tyvars_to_gen
                    mono_bind_infos
 
   ; let        poly_ids = [poly_id | (_, poly_id, _, _) <- exports]
   ; traceTc (text "binding:" <+> ppr (poly_ids `zip` map idType poly_ids))
 
   ; let abs_bind = L loc $ AbsBinds tyvars_to_gen

-                                   dict_ids exports
+                                   dict_vars exports

                                    (dict_binds `unionBags` binds')
 
   ; return ([unitBag abs_bind], poly_ids)      -- poly_ids are guaranteed zonked by mkExport
                                    (dict_binds `unionBags` binds')
 
   ; return ([unitBag abs_bind], poly_ids)      -- poly_ids are guaranteed zonked by mkExport

@@ -378,17 +379,18 @@ mkExport top_lvl prag_fn inferred_tvs dict_tys (poly_name, mb_sig, mono_id)
   = do { warn_missing_sigs <- doptM Opt_WarnMissingSigs
        ; let warn = isTopLevel top_lvl && warn_missing_sigs
        ; (tvs, poly_id) <- mk_poly_id warn mb_sig
   = do { warn_missing_sigs <- doptM Opt_WarnMissingSigs
        ; let warn = isTopLevel top_lvl && warn_missing_sigs
        ; (tvs, poly_id) <- mk_poly_id warn mb_sig

+               -- poly_id has a zonked type

 
 

-       ; poly_id' <- zonkId poly_id
-       ; prags <- tcPrags poly_id' (prag_fn poly_name)
+       ; prags <- tcPrags poly_id (prag_fn poly_name)

                -- tcPrags requires a zonked poly_id
 
                -- tcPrags requires a zonked poly_id
 

-       ; return (tvs, poly_id', mono_id, prags) }
+       ; return (tvs, poly_id, mono_id, prags) }

   where
     poly_ty = mkForAllTys inferred_tvs (mkFunTys dict_tys (idType mono_id))
 
   where
     poly_ty = mkForAllTys inferred_tvs (mkFunTys dict_tys (idType mono_id))
 

-    mk_poly_id warn Nothing    = do { missingSigWarn warn poly_name poly_ty
-                                   ; return (inferred_tvs, mkLocalId poly_name poly_ty) }
+    mk_poly_id warn Nothing    = do { poly_ty' <- zonkTcType poly_ty
+                                   ; missingSigWarn warn poly_name poly_ty'
+                                   ; return (inferred_tvs, mkLocalId poly_name poly_ty') }

     mk_poly_id warn (Just sig) = do { tvs <- mapM zonk_tv (sig_tvs sig)
                                    ; return (tvs,  sig_id sig) }
 
     mk_poly_id warn (Just sig) = do { tvs <- mapM zonk_tv (sig_tvs sig)
                                    ; return (tvs,  sig_id sig) }
 

@@ -411,7 +413,7 @@ tcPrags poly_id prags = mapM (wrapLocM tc_prag) prags
     tc_prag prag = addErrCtxt (pragSigCtxt prag) $ 
                   tcPrag poly_id prag
 
     tc_prag prag = addErrCtxt (pragSigCtxt prag) $ 
                   tcPrag poly_id prag
 

-pragSigCtxt prag = hang (ptext SLIT("In the pragma")) 2 (ppr prag)
+pragSigCtxt prag = hang (ptext (sLit "In the pragma")) 2 (ppr prag)

 
 tcPrag :: TcId -> Sig Name -> TcM Prag
 -- Pre-condition: the poly_id is zonked
 
 tcPrag :: TcId -> Sig Name -> TcM Prag
 -- Pre-condition: the poly_id is zonked

@@ -423,11 +425,10 @@ tcPrag poly_id (InlineSig v inl)             = return (InlinePrag inl)
 
 tcSpecPrag :: TcId -> LHsType Name -> InlineSpec -> TcM Prag
 tcSpecPrag poly_id hs_ty inl
 
 tcSpecPrag :: TcId -> LHsType Name -> InlineSpec -> TcM Prag
 tcSpecPrag poly_id hs_ty inl

-  = do { spec_ty <- tcHsSigType (FunSigCtxt (idName poly_id)) hs_ty
-       ; (co_fn, lie) <- getLIE (tcSubExp (idType poly_id) spec_ty)
-       ; extendLIEs lie
-       ; let const_dicts = map instToId lie
-       ; return (SpecPrag (mkHsWrap co_fn (HsVar poly_id)) spec_ty const_dicts inl) }
+  = do { let name = idName poly_id
+       ; spec_ty <- tcHsSigType (FunSigCtxt name) hs_ty
+       ; co_fn <- tcSubExp (SpecPragOrigin name) (idType poly_id) spec_ty
+       ; return (SpecPrag (mkHsWrap co_fn (HsVar poly_id)) spec_ty inl) }

        -- Most of the work of specialisation is done by 
        -- the desugarer, guided by the SpecPrag
   
        -- Most of the work of specialisation is done by 
        -- the desugarer, guided by the SpecPrag
   

@@ -476,18 +477,18 @@ checkStrictBinds top_lvl rec_group mbind mono_tys infos
     check_sig other           = return ()
 
 strictBindErr flavour unlifted mbind
     check_sig other           = return ()
 
 strictBindErr flavour unlifted mbind

-  = hang (text flavour <+> msg <+> ptext SLIT("aren't allowed:")) 
+  = hang (text flavour <+> msg <+> ptext (sLit "aren't allowed:")) 

         4 (pprLHsBinds mbind)
   where
         4 (pprLHsBinds mbind)
   where

-    msg | unlifted  = ptext SLIT("bindings for unlifted types")
-       | otherwise = ptext SLIT("bang-pattern bindings")
+    msg | unlifted  = ptext (sLit "bindings for unlifted types")
+       | otherwise = ptext (sLit "bang-pattern bindings")

 
 badStrictSig unlifted sig
 
 badStrictSig unlifted sig

-  = hang (ptext SLIT("Illegal polymorphic signature in") <+> msg)
+  = hang (ptext (sLit "Illegal polymorphic signature in") <+> msg)

         4 (ppr sig)
   where
         4 (ppr sig)
   where

-    msg | unlifted  = ptext SLIT("an unlifted binding")
-       | otherwise = ptext SLIT("a bang-pattern binding")
+    msg | unlifted  = ptext (sLit "an unlifted binding")
+       | otherwise = ptext (sLit "a bang-pattern binding")

 \end{code}
 
 
 \end{code}
 
 

@@ -546,14 +547,17 @@ tcMonoBinds [L b_loc (FunBind { fun_id = L nm_loc name, fun_infix = inf,
        -- we can (a) use genuine, rigid skolem constants for the type variables
        --        (b) bring (rigid) scoped type variables into scope
     setSrcSpan b_loc   $
        -- we can (a) use genuine, rigid skolem constants for the type variables
        --        (b) bring (rigid) scoped type variables into scope
     setSrcSpan b_loc   $

-    do { tc_sig <- tcInstSig True name scoped_tvs
+    do { tc_sig <- tcInstSig True name

        ; mono_name <- newLocalName name
        ; let mono_ty = sig_tau tc_sig
              mono_id = mkLocalId mono_name mono_ty
              rhs_tvs = [ (name, mkTyVarTy tv)
        ; mono_name <- newLocalName name
        ; let mono_ty = sig_tau tc_sig
              mono_id = mkLocalId mono_name mono_ty
              rhs_tvs = [ (name, mkTyVarTy tv)

-                       | (name, tv) <- sig_scoped tc_sig `zip` sig_tvs tc_sig ]
+                       | (name, tv) <- scoped_tvs `zip` sig_tvs tc_sig ]
+                       -- See Note [More instantiated than scoped]
+                       -- Note that the scoped_tvs and the (sig_tvs sig) 
+                       -- may have different Names. That's quite ok.

 
 

-       ; (co_fn, matches') <- tcExtendTyVarEnv2 rhs_tvs    $
+       ; (co_fn, matches') <- tcExtendTyVarEnv2 rhs_tvs $

                               tcMatchesFun mono_name inf matches mono_ty
 
        ; let fun_bind' = FunBind { fun_id = L nm_loc mono_id, 
                               tcMatchesFun mono_name inf matches mono_ty
 
        ; let fun_bind' = FunBind { fun_id = L nm_loc mono_id, 

@@ -572,9 +576,9 @@ tcMonoBinds binds sig_fn non_rec
                                -- A monomorphic binding for each term variable that lacks 
                                -- a type sig.  (Ones with a sig are already in scope.)
 
                                -- A monomorphic binding for each term variable that lacks 
                                -- a type sig.  (Ones with a sig are already in scope.)
 

-       ; binds' <- tcExtendIdEnv2    rhs_id_env $
+       ; binds' <- tcExtendIdEnv2 rhs_id_env $ do

                    traceTc (text "tcMonoBinds" <+> vcat [ ppr n <+> ppr id <+> ppr (idType id) 
                    traceTc (text "tcMonoBinds" <+> vcat [ ppr n <+> ppr id <+> ppr (idType id) 

-                                                        | (n,id) <- rhs_id_env]) `thenM_`
+                                                        | (n,id) <- rhs_id_env])

                    mapM (wrapLocM tcRhs) tc_binds
        ; return (listToBag binds', mono_info) }
 
                    mapM (wrapLocM tcRhs) tc_binds
        ; return (listToBag binds', mono_info) }
 

@@ -660,7 +664,11 @@ tcLhs sig_fn other_bind = pprPanic "tcLhs" (ppr other_bind)
 
 -------------------
 tcRhs :: TcMonoBind -> TcM (HsBind TcId)
 
 -------------------
 tcRhs :: TcMonoBind -> TcM (HsBind TcId)

-tcRhs (TcFunBind info fun'@(L _ mono_id) inf matches)
+-- When we are doing pattern bindings, or multiple function bindings at a time
+-- we *don't* bring any scoped type variables into scope
+-- Wny not?  They are not completely rigid.
+-- That's why we have the special case for a single FunBind in tcMonoBinds
+tcRhs (TcFunBind (_,_,mono_id) fun' inf matches)

   = do { (co_fn, matches') <- tcMatchesFun (idName mono_id) inf 
                                            matches (idType mono_id)
        ; return (FunBind { fun_id = fun', fun_infix = inf, fun_matches = matches',
   = do { (co_fn, matches') <- tcMatchesFun (idName mono_id) inf 
                                            matches (idType mono_id)
        ; return (FunBind { fun_id = fun', fun_infix = inf, fun_matches = matches',

@@ -736,15 +744,15 @@ generalise dflags top_lvl bind_list sig_fn mono_infos lie_req
        -- Check that signature type variables are OK
        ; final_qtvs <- checkSigsTyVars qtvs sigs
 
        -- Check that signature type variables are OK
        ; final_qtvs <- checkSigsTyVars qtvs sigs
 

-       ; returnM (final_qtvs, sig_lie, binds) }
+       ; return (final_qtvs, sig_lie, binds) }

   where
     bndrs   = bndrNames mono_infos
     sigs    = [sig | (_, Just sig, _) <- mono_infos]
   where
     bndrs   = bndrNames mono_infos
     sigs    = [sig | (_, Just sig, _) <- mono_infos]

-    tau_tvs = foldr (unionVarSet . exactTyVarsOfType . getMonoType) emptyVarSet mono_infos
-               -- NB: exactTyVarsOfType; see Note [Silly type synonym] 
-               --     near defn of TcType.exactTyVarsOfType
+    get_tvs | isTopLevel top_lvl = tyVarsOfType         -- See Note [Silly type synonym] in TcType
+           | otherwise          = exactTyVarsOfType
+    tau_tvs = foldr (unionVarSet . get_tvs . getMonoType) emptyVarSet mono_infos

     is_mono_sig sig = null (sig_theta sig)
     is_mono_sig sig = null (sig_theta sig)

-    doc = ptext SLIT("type signature(s) for") <+> pprBinders bndrs
+    doc = ptext (sLit "type signature(s) for") <+> pprBinders bndrs

 
     mkMethInst (TcSigInfo { sig_id = poly_id, sig_tvs = tvs, 
                            sig_theta = theta, sig_loc = loc }) mono_id
 
     mkMethInst (TcSigInfo { sig_id = poly_id, sig_tvs = tvs, 
                            sig_theta = theta, sig_loc = loc }) mono_id

@@ -786,13 +794,13 @@ unifyCtxts (sig1 : sigs)  -- Argument is always non-empty
               -- Then unification might succeed with a coercion.  But it's much
               -- much simpler to require that such signatures have identical contexts
               checkTc (all isIdentityCoercion cois)
               -- Then unification might succeed with a coercion.  But it's much
               -- much simpler to require that such signatures have identical contexts
               checkTc (all isIdentityCoercion cois)

-                      (ptext SLIT("Mutually dependent functions have syntactically distinct contexts"))
+                      (ptext (sLit "Mutually dependent functions have syntactically distinct contexts"))

             }
 
 checkSigsTyVars :: [TcTyVar] -> [TcSigInfo] -> TcM [TcTyVar]
 checkSigsTyVars qtvs sigs 
   = do { gbl_tvs <- tcGetGlobalTyVars
             }
 
 checkSigsTyVars :: [TcTyVar] -> [TcSigInfo] -> TcM [TcTyVar]
 checkSigsTyVars qtvs sigs 
   = do { gbl_tvs <- tcGetGlobalTyVars

-       ; sig_tvs_s <- mappM (check_sig gbl_tvs) sigs
+       ; sig_tvs_s <- mapM (check_sig gbl_tvs) sigs

 
        ; let   -- Sigh.  Make sure that all the tyvars in the type sigs
                -- appear in the returned ty var list, which is what we are
 
        ; let   -- Sigh.  Make sure that all the tyvars in the type sigs
                -- appear in the returned ty var list, which is what we are

@@ -804,15 +812,15 @@ checkSigsTyVars qtvs sigs
                -- Here, 'a' won't appear in qtvs, so we have to add it
                sig_tvs = foldl extendVarSetList emptyVarSet sig_tvs_s
                all_tvs = varSetElems (extendVarSetList sig_tvs qtvs)
                -- Here, 'a' won't appear in qtvs, so we have to add it
                sig_tvs = foldl extendVarSetList emptyVarSet sig_tvs_s
                all_tvs = varSetElems (extendVarSetList sig_tvs qtvs)

-       ; returnM all_tvs }
+       ; return all_tvs }

   where
     check_sig gbl_tvs (TcSigInfo {sig_id = id, sig_tvs = tvs, 
                                  sig_theta = theta, sig_tau = tau})
   where
     check_sig gbl_tvs (TcSigInfo {sig_id = id, sig_tvs = tvs, 
                                  sig_theta = theta, sig_tau = tau})

-      = addErrCtxt (ptext SLIT("In the type signature for") <+> quotes (ppr id))       $
+      = addErrCtxt (ptext (sLit "In the type signature for") <+> quotes (ppr id))      $

        addErrCtxtM (sigCtxt id tvs theta tau)                                          $
        do { tvs' <- checkDistinctTyVars tvs
        addErrCtxtM (sigCtxt id tvs theta tau)                                          $
        do { tvs' <- checkDistinctTyVars tvs

-          ; ifM (any (`elemVarSet` gbl_tvs) tvs')
-                (bleatEscapedTvs gbl_tvs tvs tvs') 
+          ; when (any (`elemVarSet` gbl_tvs) tvs')
+                 (bleatEscapedTvs gbl_tvs tvs tvs')

           ; return tvs' }
 
 checkDistinctTyVars :: [TcTyVar] -> TcM [TcTyVar]
           ; return tvs' }
 
 checkDistinctTyVars :: [TcTyVar] -> TcM [TcTyVar]

@@ -843,8 +851,8 @@ checkDistinctTyVars sig_tvs
        = do { env0 <- tcInitTidyEnv
            ; let (env1, tidy_tv1) = tidyOpenTyVar env0 sig_tv1
                  (env2, tidy_tv2) = tidyOpenTyVar env1 sig_tv2
        = do { env0 <- tcInitTidyEnv
            ; let (env1, tidy_tv1) = tidyOpenTyVar env0 sig_tv1
                  (env2, tidy_tv2) = tidyOpenTyVar env1 sig_tv2

-                 msg = ptext SLIT("Quantified type variable") <+> quotes (ppr tidy_tv1) 
-                        <+> ptext SLIT("is unified with another quantified type variable") 
+                 msg = ptext (sLit "Quantified type variable") <+> quotes (ppr tidy_tv1) 
+                        <+> ptext (sLit "is unified with another quantified type variable") 

                         <+> quotes (ppr tidy_tv2)
            ; failWithTcM (env2, msg) }
        where
                         <+> quotes (ppr tidy_tv2)
            ; failWithTcM (env2, msg) }
        where

@@ -968,6 +976,44 @@ The @TcSigInfo@ contains @TcTypes@ because they are unified with
 the variable's type, and after that checked to see whether they've
 been instantiated.
 
 the variable's type, and after that checked to see whether they've
 been instantiated.
 

+Note [Scoped tyvars]
+~~~~~~~~~~~~~~~~~~~~
+The -XScopedTypeVariables flag brings lexically-scoped type variables
+into scope for any explicitly forall-quantified type variables:
+       f :: forall a. a -> a
+       f x = e
+Then 'a' is in scope inside 'e'.
+
+However, we do *not* support this 
+  - For pattern bindings e.g
+       f :: forall a. a->a
+       (f,g) = e
+
+  - For multiple function bindings, unless Opt_RelaxedPolyRec is on
+       f :: forall a. a -> a
+       f = g
+       g :: forall b. b -> b
+       g = ...f...
+    Reason: we use mutable variables for 'a' and 'b', since they may
+    unify to each other, and that means the scoped type variable would
+    not stand for a completely rigid variable.
+
+    Currently, we simply make Opt_ScopedTypeVariables imply Opt_RelaxedPolyRec
+
+
+Note [More instantiated than scoped]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+There may be more instantiated type variables than lexically-scoped 
+ones.  For example:
+       type T a = forall b. b -> (a,b)
+       f :: forall c. T c
+Here, the signature for f will have one scoped type variable, c,
+but two instantiated type variables, c' and b'.  
+
+We assume that the scoped ones are at the *front* of sig_tvs,
+and remember the names from the original HsForAllTy in the TcSigFun.
+
+

 \begin{code}
 type TcSigFun = Name -> Maybe [Name]   -- Maps a let-binder to the list of
                                        -- type variables brought into scope
 \begin{code}
 type TcSigFun = Name -> Maybe [Name]   -- Maps a let-binder to the list of
                                        -- type variables brought into scope

@@ -984,7 +1030,7 @@ mkTcSigFun sigs = lookupNameEnv env
                    | L span (TypeSig (L _ name) lhs_ty) <- sigs]
        -- The scoped names are the ones explicitly mentioned
        -- in the HsForAll.  (There may be more in sigma_ty, because
                    | L span (TypeSig (L _ name) lhs_ty) <- sigs]
        -- The scoped names are the ones explicitly mentioned
        -- in the HsForAll.  (There may be more in sigma_ty, because

-       -- of nested type synonyms.  See Note [Scoped] with TcSigInfo.)
+       -- of nested type synonyms.  See Note [More instantiated than scoped].)

        -- See Note [Only scoped tyvars are in the TyVarEnv]
 
 ---------------
        -- See Note [Only scoped tyvars are in the TyVarEnv]
 
 ---------------

@@ -992,10 +1038,6 @@ data TcSigInfo
   = TcSigInfo {
        sig_id     :: TcId,             --  *Polymorphic* binder for this value...
 
   = TcSigInfo {
        sig_id     :: TcId,             --  *Polymorphic* binder for this value...
 

-       sig_scoped :: [Name],           -- Names for any scoped type variables
-                                       -- Invariant: correspond 1-1 with an initial
-                                       -- segment of sig_tvs (see Note [Scoped])
-

        sig_tvs    :: [TcTyVar],        -- Instantiated type variables
                                        -- See Note [Instantiate sig]
 
        sig_tvs    :: [TcTyVar],        -- Instantiated type variables
                                        -- See Note [Instantiate sig]
 

@@ -1017,17 +1059,6 @@ data TcSigInfo
 -- only the lexically scoped ones into the environment.
 
 
 -- only the lexically scoped ones into the environment.
 
 

---     Note [Scoped]
--- There may be more instantiated type variables than scoped 
--- ones.  For example:
---     type T a = forall b. b -> (a,b)
---     f :: forall c. T c
--- Here, the signature for f will have one scoped type variable, c,
--- but two instantiated type variables, c' and b'.  
---
--- We assume that the scoped ones are at the *front* of sig_tvs,
--- and remember the names from the original HsForAllTy in sig_scoped
-

 --     Note [Instantiate sig]
 -- It's vital to instantiate a type signature with fresh variables.
 -- For example:
 --     Note [Instantiate sig]
 -- It's vital to instantiate a type signature with fresh variables.
 -- For example:

@@ -1041,7 +1072,7 @@ data TcSigInfo
 
 instance Outputable TcSigInfo where
     ppr (TcSigInfo { sig_id = id, sig_tvs = tyvars, sig_theta = theta, sig_tau = tau})
 
 instance Outputable TcSigInfo where
     ppr (TcSigInfo { sig_id = id, sig_tvs = tyvars, sig_theta = theta, sig_tau = tau})

-       = ppr id <+> ptext SLIT("::") <+> ppr tyvars <+> ppr theta <+> ptext SLIT("=>") <+> ppr tau
+       = ppr id <+> ptext (sLit "::") <+> ppr tyvars <+> ppr theta <+> ptext (sLit "=>") <+> ppr tau

 \end{code}
 
 \begin{code}
 \end{code}
 
 \begin{code}

@@ -1058,10 +1089,12 @@ tcInstSig_maybe :: TcSigFun -> Name -> TcM (Maybe TcSigInfo)
 tcInstSig_maybe sig_fn name 
   = case sig_fn name of
        Nothing  -> return Nothing
 tcInstSig_maybe sig_fn name 
   = case sig_fn name of
        Nothing  -> return Nothing

-       Just tvs -> do  { tc_sig <- tcInstSig False name tvs
-                       ; return (Just tc_sig) }
+       Just scoped_tvs -> do   { tc_sig <- tcInstSig False name
+                               ; return (Just tc_sig) }
+       -- NB: the scoped_tvs may be non-empty, but we can 
+       -- just ignore them.  See Note [Scoped tyvars].

 
 

-tcInstSig :: Bool -> Name -> [Name] -> TcM TcSigInfo
+tcInstSig :: Bool -> Name -> TcM TcSigInfo

 -- Instantiate the signature, with either skolems or meta-type variables
 -- depending on the use_skols boolean.  This variable is set True
 -- when we are typechecking a single function binding; and False for
 -- Instantiate the signature, with either skolems or meta-type variables
 -- depending on the use_skols boolean.  This variable is set True
 -- when we are typechecking a single function binding; and False for

@@ -1080,7 +1113,7 @@ tcInstSig :: Bool -> Name -> [Name] -> TcM TcSigInfo
 --
 -- We must not use the same 'a' from the defn of T at both places!!
 
 --
 -- We must not use the same 'a' from the defn of T at both places!!
 

-tcInstSig use_skols name scoped_names
+tcInstSig use_skols name

   = do { poly_id <- tcLookupId name    -- Cannot fail; the poly ids are put into 
                                        -- scope when starting the binding group
        ; let skol_info = SigSkol (FunSigCtxt name)
   = do { poly_id <- tcLookupId name    -- Cannot fail; the poly ids are put into 
                                        -- scope when starting the binding group
        ; let skol_info = SigSkol (FunSigCtxt name)

@@ -1089,15 +1122,7 @@ tcInstSig use_skols name scoped_names
        ; loc <- getInstLoc (SigOrigin skol_info)
        ; return (TcSigInfo { sig_id = poly_id,
                              sig_tvs = tvs, sig_theta = theta, sig_tau = tau, 
        ; loc <- getInstLoc (SigOrigin skol_info)
        ; return (TcSigInfo { sig_id = poly_id,
                              sig_tvs = tvs, sig_theta = theta, sig_tau = tau, 

-                             sig_scoped = final_scoped_names, sig_loc = loc }) }
-               -- Note that the scoped_names and the sig_tvs will have
-               -- different Names. That's quite ok; when we bring the 
-               -- scoped_names into scope, we just bind them to the sig_tvs
-  where
-       -- We also only have scoped type variables when we are instantiating
-       -- with true skolems
-    final_scoped_names | use_skols = scoped_names
-                      | otherwise = []
+                             sig_loc = loc }) }

 
 -------------------
 isMonoGroup :: DynFlags -> [LHsBind Name] -> Bool
 
 -------------------
 isMonoGroup :: DynFlags -> [LHsBind Name] -> Bool

@@ -1140,14 +1165,14 @@ isRestrictedGroup dflags binds sig_fn
 -- This one is called on LHS, when pat and grhss are both Name 
 -- and on RHS, when pat is TcId and grhss is still Name
 patMonoBindsCtxt pat grhss
 -- This one is called on LHS, when pat and grhss are both Name 
 -- and on RHS, when pat is TcId and grhss is still Name
 patMonoBindsCtxt pat grhss

-  = hang (ptext SLIT("In a pattern binding:")) 4 (pprPatBind pat grhss)
+  = hang (ptext (sLit "In a pattern binding:")) 4 (pprPatBind pat grhss)

 
 -----------------------------------------------
 sigContextsCtxt sig1 sig2
 
 -----------------------------------------------
 sigContextsCtxt sig1 sig2

-  = vcat [ptext SLIT("When matching the contexts of the signatures for"), 
+  = vcat [ptext (sLit "When matching the contexts of the signatures for"), 

          nest 2 (vcat [ppr id1 <+> dcolon <+> ppr (idType id1),
                        ppr id2 <+> dcolon <+> ppr (idType id2)]),
          nest 2 (vcat [ppr id1 <+> dcolon <+> ppr (idType id1),
                        ppr id2 <+> dcolon <+> ppr (idType id2)]),

-         ptext SLIT("The signature contexts in a mutually recursive group should all be identical")]
+         ptext (sLit "The signature contexts in a mutually recursive group should all be identical")]

   where
     id1 = sig_id sig1
     id2 = sig_id sig2
   where
     id1 = sig_id sig1
     id2 = sig_id sig2

@@ -1155,17 +1180,17 @@ sigContextsCtxt sig1 sig2
 
 -----------------------------------------------
 unboxedTupleErr name ty
 
 -----------------------------------------------
 unboxedTupleErr name ty

-  = hang (ptext SLIT("Illegal binding of unboxed tuple"))
+  = hang (ptext (sLit "Illegal binding of unboxed tuple"))

         4 (ppr name <+> dcolon <+> ppr ty)
 
 -----------------------------------------------
 restrictedBindCtxtErr binder_names
         4 (ppr name <+> dcolon <+> ppr ty)
 
 -----------------------------------------------
 restrictedBindCtxtErr binder_names

-  = hang (ptext SLIT("Illegal overloaded type signature(s)"))
-       4 (vcat [ptext SLIT("in a binding group for") <+> pprBinders binder_names,
-               ptext SLIT("that falls under the monomorphism restriction")])
+  = hang (ptext (sLit "Illegal overloaded type signature(s)"))
+       4 (vcat [ptext (sLit "in a binding group for") <+> pprBinders binder_names,
+               ptext (sLit "that falls under the monomorphism restriction")])

 
 genCtxt binder_names
 
 genCtxt binder_names

-  = ptext SLIT("When generalising the type(s) for") <+> pprBinders binder_names
+  = ptext (sLit "When generalising the type(s) for") <+> pprBinders binder_names

 
 missingSigWarn False name ty = return ()
 missingSigWarn True  name ty
 
 missingSigWarn False name ty = return ()
 missingSigWarn True  name ty

@@ -1173,6 +1198,6 @@ missingSigWarn True  name ty
        ; let (env1, tidy_ty) = tidyOpenType env0 ty
        ; addWarnTcM (env1, mk_msg tidy_ty) }
   where
        ; let (env1, tidy_ty) = tidyOpenType env0 ty
        ; addWarnTcM (env1, mk_msg tidy_ty) }
   where

-    mk_msg ty = vcat [ptext SLIT("Definition but no type signature for") <+> quotes (ppr name),
-                     sep [ptext SLIT("Inferred type:") <+> ppr name <+> dcolon <+> ppr ty]]
+    mk_msg ty = vcat [ptext (sLit "Definition but no type signature for") <+> quotes (ppr name),
+                     sep [ptext (sLit "Inferred type:") <+> pprHsVar name <+> dcolon <+> ppr ty]]

 \end{code}
 \end{code}