Revert multiple commits

This reverts multiple commits from Simon:

  - 04a484eafc9eb9f8774b4bdd41a5dc6c9f640daf Test Trac #10359
  - a9ccd37add8315e061c02e5bf26c08f05fad9ac9 Test Trac #10403
  - c0aae6f699cbd222d826d0b8d78d6cb3f682079e Test Trac #10248
  - eb6ca851f553262efe0824b8dcbe64952de4963d Make the "matchable-given" check happen first
  - ca173aa30467a0b1023682d573fcd94244d85c50 Add a case to checkValidTyCon
  - 51cbad15f86fca1d1b0e777199eb1079a1b64d74 Update haddock submodule
  - 6e1174da5b8e0b296f5bfc8b39904300d04eb5b7 Separate transCloVarSet from fixVarSet
  - a8493e03b89f3b3bfcdb6005795de050501f5c29 Fix imports in HscMain (stage2)
  - a154944bf07b2e13175519bafebd5a03926bf105 Two wibbles to fix the build
  - 5910a1bc8142b4e56a19abea104263d7bb5c5d3f Change in capitalisation of error msg
  - 130e93aab220bdf14d08028771f83df210da340b Refactor tuple constraints
  - 8da785d59f5989b9a9df06386d5bd13f65435bc0 Delete commented-out line

These break the build by causing Haddock to fail mysteriously when
trying to examine GHC.Prim it seems.

2 files changed, 46 insertions, 138 deletions

diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index 7ffa6b6a05..eb2aa0c276 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -80,7 +80,7 @@ import TcEvidence       ( emptyTcEvBinds )
 -- compiler/prelude
 import ForeignCall
 import TysPrim          ( liftedTypeKindTyConName, eqPrimTyCon )
-import TysWiredIn       ( unitTyCon, unitDataCon, tupleTyCon, tupleDataCon, nilDataCon,
+import TysWiredIn       ( unitTyCon, unitDataCon, tupleTyCon, tupleCon, nilDataCon,
                           unboxedUnitTyCon, unboxedUnitDataCon,
                           listTyCon_RDR, parrTyCon_RDR, consDataCon_RDR, eqTyCon_RDR )
 
@@ -728,9 +728,10 @@ qcname_ext :: { Located RdrName }       -- Variable or data constructor
         |  'type' qcname            {% amms (mkTypeImpExp (sLL $1 $> (unLoc $2)))
                                             [mj AnnType $1,mj AnnVal $2] }
 
-qcname  :: { Located RdrName }  -- Variable or type constructor
+-- Cannot pull into qcname_ext, as qcname is also used in expression.
+qcname  :: { Located RdrName }  -- Variable or data constructor
         :  qvar                         { $1 }
-        |  oqtycon                      { $1 }
+        |  qcon                         { $1 }
 
 -----------------------------------------------------------------------------
 -- Import Declarations
@@ -2276,9 +2277,8 @@ aexp1   :: { LHsExpr RdrName }
         | aexp2                { $1 }
 
 aexp2   :: { LHsExpr RdrName }
-        : qvar                          { sL1 $1 (HsVar   $! unLoc $1) }
-        | qcon                          { sL1 $1 (HsVar   $! unLoc $1) }
-        | ipvar                         { sL1 $1 (HsIPVar $! unLoc $1) }
+        : ipvar                         { sL1 $1 (HsIPVar $! unLoc $1) }
+        | qcname                        { sL1 $1 (HsVar   $! unLoc $1) }
         | literal                       { sL1 $1 (HsLit   $! unLoc $1) }
 -- This will enable overloaded strings permanently.  Normally the renamer turns HsString
 -- into HsOverLit when -foverloaded-strings is on.
@@ -2803,10 +2803,10 @@ con_list : con                  { sL1 $1 [$1] }
 
 sysdcon_nolist :: { Located DataCon }  -- Wired in data constructors
         : '(' ')'               {% ams (sLL $1 $> unitDataCon) [mop $1,mcp $2] }
-        | '(' commas ')'        {% ams (sLL $1 $> $ tupleDataCon Boxed (snd $2 + 1))
+        | '(' commas ')'        {% ams (sLL $1 $> $ tupleCon BoxedTuple (snd $2 + 1))
                                        (mop $1:mcp $3:(mcommas (fst $2))) }
         | '(#' '#)'             {% ams (sLL $1 $> $ unboxedUnitDataCon) [mo $1,mc $2] }
-        | '(#' commas '#)'      {% ams (sLL $1 $> $ tupleDataCon Unboxed (snd $2 + 1))
+        | '(#' commas '#)'      {% ams (sLL $1 $> $ tupleCon UnboxedTuple (snd $2 + 1))
                                        (mo $1:mc $3:(mcommas (fst $2))) }
 
 sysdcon :: { Located DataCon }
@@ -2840,10 +2840,10 @@ gtycon :: { Located RdrName }  -- A "general" qualified tycon, including unit tu
 
 ntgtycon :: { Located RdrName }  -- A "general" qualified tycon, excluding unit tuples
         : oqtycon               { $1 }
-        | '(' commas ')'        {% ams (sLL $1 $> $ getRdrName (tupleTyCon Boxed
+        | '(' commas ')'        {% ams (sLL $1 $> $ getRdrName (tupleTyCon BoxedTuple
                                                         (snd $2 + 1)))
                                        (mop $1:mcp $3:(mcommas (fst $2))) }
-        | '(#' commas '#)'      {% ams (sLL $1 $> $ getRdrName (tupleTyCon Unboxed
+        | '(#' commas '#)'      {% ams (sLL $1 $> $ getRdrName (tupleTyCon UnboxedTuple
                                                         (snd $2 + 1)))
                                        (mo $1:mc $3:(mcommas (fst $2))) }
         | '(' '->' ')'          {% ams (sLL $1 $> $ getRdrName funTyCon)
diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs
index 39589fe72c..f0dc1ea433 100644
--- a/compiler/parser/RdrHsSyn.hs
+++ b/compiler/parser/RdrHsSyn.hs
@@ -21,7 +21,6 @@ module RdrHsSyn (
         mkPatSynMatchGroup,
         mkRecConstrOrUpdate, -- HsExp -> [HsFieldUpdate] -> P HsExp
         mkTyClD, mkInstD,
-        setRdrNameSpace,
 
         cvBindGroup,
         cvBindsAndSigs,
@@ -66,24 +65,24 @@ module RdrHsSyn (
 
 import HsSyn            -- Lots of it
 import Class            ( FunDep )
-import TyCon            ( TyCon, isTupleTyCon, tyConSingleDataCon_maybe )
-import DataCon          ( DataCon, dataConTyCon )
-import ConLike          ( ConLike(..) )
 import CoAxiom          ( Role, fsFromRole )
-import RdrName
-import Name
-import BasicTypes
+import RdrName          ( RdrName, isRdrTyVar, isRdrTc, mkUnqual, rdrNameOcc,
+                          isRdrDataCon, isUnqual, getRdrName, setRdrNameSpace,
+                          rdrNameSpace )
+import OccName          ( tcClsName, isVarNameSpace )
+import Name             ( Name )
+import BasicTypes       ( maxPrecedence, Activation(..), RuleMatchInfo,
+                          InlinePragma(..), InlineSpec(..), Origin(..),
+                          SourceText )
 import TcEvidence       ( idHsWrapper )
 import Lexer
-import Type             ( TyThing(..) )
-import TysWiredIn       ( cTupleTyConName, tupleTyCon, tupleDataCon,
-                          nilDataConName, nilDataConKey,
-                          listTyConName, listTyConKey )
+import TysWiredIn       ( unitTyCon, unitDataCon )
 import ForeignCall
+import OccName          ( srcDataName, varName, isDataOcc, isTcOcc,
+                          occNameString )
 import PrelNames        ( forall_tv_RDR, allNameStrings )
 import DynFlags
 import SrcLoc
-import Unique           ( hasKey )
 import OrdList          ( OrdList, fromOL )
 import Bag              ( emptyBag, consBag )
 import Outputable
@@ -138,7 +137,7 @@ mkClassDecl :: SrcSpan
 mkClassDecl loc (L _ (mcxt, tycl_hdr)) fds where_cls
   = do { (binds, sigs, ats, at_insts, _, docs) <- cvBindsAndSigs where_cls
        ; let cxt = fromMaybe (noLoc []) mcxt
-       ; (cls, tparams,ann) <- checkTyClHdr True tycl_hdr
+       ; (cls, tparams,ann) <- checkTyClHdr tycl_hdr
        ; mapM_ (\a -> a loc) ann -- Add any API Annotations to the top SrcSpan
        -- Partial type signatures are not allowed in a class definition
        ; checkNoPartialSigs sigs cls
@@ -272,7 +271,7 @@ mkTyData :: SrcSpan
          -> Maybe (Located [LHsType RdrName])
          -> P (LTyClDecl RdrName)
 mkTyData loc new_or_data cType (L _ (mcxt, tycl_hdr)) ksig data_cons maybe_deriv
-  = do { (tc, tparams,ann) <- checkTyClHdr False tycl_hdr
+  = do { (tc, tparams,ann) <- checkTyClHdr tycl_hdr
        ; mapM_ (\a -> a loc) ann -- Add any API Annotations to the top SrcSpan
        ; tyvars <- checkTyVarsP (ppr new_or_data) equalsDots tc tparams
        ; defn <- mkDataDefn new_or_data cType mcxt ksig data_cons maybe_deriv
@@ -307,7 +306,7 @@ mkTySynonym :: SrcSpan
             -> LHsType RdrName  -- RHS
             -> P (LTyClDecl RdrName)
 mkTySynonym loc lhs rhs
-  = do { (tc, tparams,ann) <- checkTyClHdr False lhs
+  = do { (tc, tparams,ann) <- checkTyClHdr lhs
        ; mapM_ (\a -> a loc) ann -- Add any API Annotations to the top SrcSpan
        ; tyvars <- checkTyVarsP (ptext (sLit "type")) equalsDots tc tparams
        ; let err = text "In type synonym" <+> quotes (ppr tc) <>
@@ -320,7 +319,7 @@ mkTyFamInstEqn :: LHsType RdrName
                -> LHsType RdrName
                -> P (TyFamInstEqn RdrName,[AddAnn])
 mkTyFamInstEqn lhs rhs
-  = do { (tc, tparams,ann) <- checkTyClHdr False lhs
+  = do { (tc, tparams,ann) <- checkTyClHdr lhs
        ; let err xhs = hang (text "In type family instance equation of" <+>
                              quotes (ppr tc) <> colon)
                        2 (ppr xhs)
@@ -340,7 +339,7 @@ mkDataFamInst :: SrcSpan
          -> Maybe (Located [LHsType RdrName])
          -> P (LInstDecl RdrName)
 mkDataFamInst loc new_or_data cType (L _ (mcxt, tycl_hdr)) ksig data_cons maybe_deriv
-  = do { (tc, tparams,ann) <- checkTyClHdr False tycl_hdr
+  = do { (tc, tparams,ann) <- checkTyClHdr tycl_hdr
        ; mapM_ (\a -> a loc) ann -- Add any API Annotations to the top SrcSpan
        ; defn <- mkDataDefn new_or_data cType mcxt ksig data_cons maybe_deriv
        ; return (L loc (DataFamInstD (
@@ -360,7 +359,7 @@ mkFamDecl :: SrcSpan
           -> Maybe (LHsKind RdrName) -- Optional kind signature
           -> P (LTyClDecl RdrName)
 mkFamDecl loc info lhs ksig
-  = do { (tc, tparams,ann) <- checkTyClHdr False lhs
+  = do { (tc, tparams,ann) <- checkTyClHdr lhs
        ; mapM_ (\a -> a loc) ann -- Add any API Annotations to the top SrcSpan
        ; tyvars <- checkTyVarsP (ppr info) equals_or_where tc tparams
        ; return (L loc (FamDecl (FamilyDecl { fdInfo = info, fdLName = tc
@@ -546,9 +545,9 @@ splitCon ty
    split (L _ (HsAppTy t u)) ts    = split t (u : ts)
    split (L l (HsTyVar tc))  ts    = do data_con <- tyConToDataCon l tc
                                         return (data_con, mk_rest ts)
-   split (L l (HsTupleTy HsBoxedOrConstraintTuple ts)) []
-      = return (L l (getRdrName (tupleDataCon Boxed (length ts))), PrefixCon ts)
-   split (L l _) _ = parseErrorSDoc l (text "Cannot parse data constructor in a data/newtype declaration:" <+> ppr ty)
+   split (L l (HsTupleTy _ [])) [] = return (L l (getRdrName unitDataCon), PrefixCon [])
+                                         -- See Note [Unit tuples] in HsTypes
+   split (L l _) _                 = parseErrorSDoc l (text "Cannot parse data constructor in a data/newtype declaration:" <+> ppr ty)
 
    mk_rest [L l (HsRecTy flds)] = RecCon (L l flds)
    mk_rest ts                   = PrefixCon ts
@@ -663,91 +662,6 @@ tyConToDataCon loc tc
           = text "Perhaps you intended to use ExistentialQuantification"
           | otherwise = empty
 
-setRdrNameSpace :: RdrName -> NameSpace -> RdrName
--- ^ This rather gruesome function is used mainly by the parser.
--- When parsing:
---
--- > data T a = T | T1 Int
---
--- we parse the data constructors as /types/ because of parser ambiguities,
--- so then we need to change the /type constr/ to a /data constr/
---
--- The exact-name case /can/ occur when parsing:
---
--- > data [] a = [] | a : [a]
---
--- For the exact-name case we return an original name.
-setRdrNameSpace (Unqual occ) ns = Unqual (setOccNameSpace ns occ)
-setRdrNameSpace (Qual m occ) ns = Qual m (setOccNameSpace ns occ)
-setRdrNameSpace (Orig m occ) ns = Orig m (setOccNameSpace ns occ)
-setRdrNameSpace (Exact n)    ns
-  | Just thing <- wiredInNameTyThing_maybe n
-  = setWiredInNameSpace thing ns
-    -- Preserve Exact Names for wired-in things,
-    -- notably tuples and lists
-
-  | isExternalName n
-  = Orig (nameModule n) occ
-
-  | otherwise   -- This can happen when quoting and then
-                -- splicing a fixity declaration for a type
-  = Exact (mkSystemNameAt (nameUnique n) occ (nameSrcSpan n))
-  where
-    occ = setOccNameSpace ns (nameOccName n)
-
-setWiredInNameSpace :: TyThing -> NameSpace -> RdrName
-setWiredInNameSpace (ATyCon tc) ns
-  | isDataConNameSpace ns
-  = ty_con_data_con tc
-  | isTcClsNameSpace ns
-  = Exact (getName tc)      -- No-op
-
-setWiredInNameSpace (AConLike (RealDataCon dc)) ns
-  | isTcClsNameSpace ns
-  = data_con_ty_con dc
-  | isDataConNameSpace ns
-  = Exact (getName dc)      -- No-op
-
-setWiredInNameSpace thing ns
-  = pprPanic "setWiredinNameSpace" (pprNameSpace ns <+> ppr thing)
-
-ty_con_data_con :: TyCon -> RdrName
-ty_con_data_con tc
-  | isTupleTyCon tc
-  , Just dc <- tyConSingleDataCon_maybe tc
-  = Exact (getName dc)
-
-  | tc `hasKey` listTyConKey
-  = Exact nilDataConName
-
-  | otherwise  -- See Note [setRdrNameSpace for wired-in names]
-  = Unqual (setOccNameSpace srcDataName (getOccName tc))
-
-data_con_ty_con :: DataCon -> RdrName
-data_con_ty_con dc
-  | let tc = dataConTyCon dc
-  , isTupleTyCon tc
-  = Exact (getName tc)
-
-  | dc `hasKey` nilDataConKey
-  = Exact listTyConName
-
-  | otherwise  -- See Note [setRdrNameSpace for wired-in names]
-  = Unqual (setOccNameSpace tcClsName (getOccName dc))
-
-
-{- Note [setRdrNameSpace for wired-in names]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-In GHC.Types, which declares (:), we have
-  infixr 5 :
-The ambiguity about which ":" is meant is resolved by parsing it as a
-data constructor, but then using dataTcOccs to try the type constructor too;
-and that in turn calls setRdrNameSpace to change the name-space of ":" to
-tcClsName.  There isn't a corresponding ":" type constructor, but it's painful
-to make setRdrNameSpace partial, so we just make an Unqual name instead. It
-really doesn't matter!
--}
-
 -- | Note [Sorting out the result type]
 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 -- In a GADT declaration which is not a record, we put the whole constr
@@ -824,9 +738,7 @@ checkRecordSyntax lr@(L loc r)
                       (text "Illegal record syntax (use TraditionalRecordSyntax):" <+>
                        ppr r)
 
-checkTyClHdr :: Bool               -- True  <=> class header
-                                   -- False <=> type header
-             -> LHsType RdrName
+checkTyClHdr :: LHsType RdrName
              -> P (Located RdrName,          -- the head symbol (type or class name)
                    [LHsType RdrName],        -- parameters of head symbol
                    [AddAnn]) -- API Annotation for HsParTy when stripping parens
@@ -834,28 +746,22 @@ checkTyClHdr :: Bool               -- True  <=> class header
 -- Decomposes   T ty1 .. tyn   into    (T, [ty1, ..., tyn])
 --              Int :*: Bool   into    (:*:, [Int, Bool])
 -- returning the pieces
-checkTyClHdr is_cls ty
+checkTyClHdr ty
   = goL ty [] []
   where
     goL (L l ty) acc ann = go l ty acc ann
 
     go l (HsTyVar tc) acc ann
-      | isRdrTc tc               = return (L l tc, acc, ann)
+        | isRdrTc tc             = return (L l tc, acc, ann)
     go _ (HsOpTy t1 (_, ltc@(L _ tc)) t2) acc ann
-      | isRdrTc tc               = return (ltc, t1:t2:acc, ann)
+        | isRdrTc tc             = return (ltc, t1:t2:acc, ann)
     go l (HsParTy ty)    acc ann = goL ty acc (ann ++ mkParensApiAnn l)
     go _ (HsAppTy t1 t2) acc ann = goL t1 (t2:acc) ann
-
-    go l (HsTupleTy HsBoxedOrConstraintTuple ts) [] ann
-      = return (L l (nameRdrName tup_name), ts, ann)
-      where
-        arity = length ts
-        tup_name | is_cls    = cTupleTyConName arity
-                 | otherwise = getName (tupleTyCon Boxed arity)
-                 -- See Note [Unit tuples] in HsTypes  (TODO: is this still relevant?)
-    go l _  _  _
-      = parseErrorSDoc l (text "Malformed head of type or class declaration:"
-                          <+> ppr ty)
+    go l (HsTupleTy _ []) [] ann = return (L l (getRdrName unitTyCon), [],ann)
+                                   -- See Note [Unit tuples] in HsTypes
+    go l _               _   _
+         = parseErrorSDoc l (text "Malformed head of type or class declaration:"
+                             <+> ppr ty)
 
 checkContext :: LHsType RdrName -> P (LHsContext RdrName)
 checkContext (L l orig_t)
@@ -1575,12 +1481,14 @@ mkModuleImpExp n@(L l name) subs =
   case subs of
     ImpExpAbs
       | isVarNameSpace (rdrNameSpace name) -> IEVar       n
-      | otherwise                          -> IEThingAbs  (L l name)
-    ImpExpAll                              -> IEThingAll  (L l name)
-    ImpExpList xs                          -> IEThingWith (L l name) xs
+      | otherwise                          -> IEThingAbs  (L l nameT)
+    ImpExpAll                              -> IEThingAll  (L l nameT)
+    ImpExpList xs                          -> IEThingWith (L l nameT) xs
+
+  where
+    nameT = setRdrNameSpace name tcClsName
 
-mkTypeImpExp :: Located RdrName   -- TcCls or Var name space
-             -> P (Located RdrName)
+mkTypeImpExp :: Located RdrName -> P (Located RdrName)
 mkTypeImpExp name =
   do allowed <- extension explicitNamespacesEnabled
      if allowed