Udate hsSyn AST to use Trees that Grow
authorAlan Zimmerman <alan.zimm@gmail.com>
Fri, 19 May 2017 12:56:09 +0000 (14:56 +0200)
committerAlan Zimmerman <alan.zimm@gmail.com>
Mon, 5 Jun 2017 22:16:20 +0000 (00:16 +0200)
Summary:
See https://ghc.haskell.org/trac/ghc/wiki/ImplementingTreesThatGrow

This commit prepares the ground for a full extensible AST, by replacing the type
parameter for the hsSyn data types with a set of indices into type families,

    data GhcPs -- ^ Index for GHC parser output
    data GhcRn -- ^ Index for GHC renamer output
    data GhcTc -- ^ Index for GHC typechecker output

These are now used instead of `RdrName`, `Name` and `Id`/`TcId`/`Var`

Where the original name type is required in a polymorphic context, this is
accessible via the IdP type family, defined as

    type family IdP p
    type instance IdP GhcPs = RdrName
    type instance IdP GhcRn = Name
    type instance IdP GhcTc = Id

These types are declared in the new 'hsSyn/HsExtension.hs' module.

To gain a better understanding of the extension mechanism, it has been applied
to `HsLit` only, also replacing the `SourceText` fields in them with extension
types.

To preserve extension generality, a type class is introduced to capture the
`SourceText` interface, which must be honoured by all of the extension points
which originally had a `SourceText`.  The class is defined as

    class HasSourceText a where
      -- Provide setters to mimic existing constructors
      noSourceText  :: a
      sourceText    :: String -> a

      setSourceText :: SourceText -> a
      getSourceText :: a -> SourceText

And the constraint is captured in `SourceTextX`, which is a constraint type
listing all the extension points that make use of the class.

Updating Haddock submodule to match.

Test Plan: ./validate

Reviewers: simonpj, shayan-najd, goldfire, austin, bgamari

Subscribers: rwbarton, thomie, mpickering

Differential Revision: https://phabricator.haskell.org/D3609

111 files changed:
compiler/backpack/BkpSyn.hs
compiler/backpack/DriverBkp.hs
compiler/deSugar/Check.hs
compiler/deSugar/Coverage.hs
compiler/deSugar/Desugar.hs
compiler/deSugar/DsArrows.hs
compiler/deSugar/DsBinds.hs
compiler/deSugar/DsExpr.hs
compiler/deSugar/DsExpr.hs-boot
compiler/deSugar/DsForeign.hs
compiler/deSugar/DsGRHSs.hs
compiler/deSugar/DsListComp.hs
compiler/deSugar/DsMeta.hs
compiler/deSugar/DsMonad.hs
compiler/deSugar/DsUtils.hs
compiler/deSugar/Match.hs
compiler/deSugar/Match.hs-boot
compiler/deSugar/MatchCon.hs
compiler/deSugar/MatchLit.hs
compiler/deSugar/PmExpr.hs
compiler/ghc.cabal.in
compiler/ghc.mk
compiler/hsSyn/Convert.hs
compiler/hsSyn/HsBinds.hs
compiler/hsSyn/HsDecls.hs
compiler/hsSyn/HsDumpAst.hs
compiler/hsSyn/HsExpr.hs
compiler/hsSyn/HsExpr.hs-boot
compiler/hsSyn/HsExtension.hs [new file with mode: 0644]
compiler/hsSyn/HsImpExp.hs
compiler/hsSyn/HsLit.hs
compiler/hsSyn/HsPat.hs
compiler/hsSyn/HsPat.hs-boot
compiler/hsSyn/HsSyn.hs
compiler/hsSyn/HsTypes.hs
compiler/hsSyn/HsUtils.hs
compiler/hsSyn/PlaceHolder.hs
compiler/main/GHC.hs
compiler/main/HeaderInfo.hs
compiler/main/Hooks.hs
compiler/main/HscMain.hs
compiler/main/HscStats.hs
compiler/main/HscTypes.hs
compiler/main/InteractiveEval.hs
compiler/parser/Parser.y
compiler/parser/RdrHsSyn.hs
compiler/rename/RnBinds.hs
compiler/rename/RnEnv.hs
compiler/rename/RnExpr.hs
compiler/rename/RnExpr.hs-boot
compiler/rename/RnFixity.hs
compiler/rename/RnNames.hs
compiler/rename/RnPat.hs
compiler/rename/RnSource.hs
compiler/rename/RnSplice.hs
compiler/rename/RnSplice.hs-boot
compiler/rename/RnTypes.hs
compiler/rename/RnUtils.hs
compiler/typecheck/Inst.hs
compiler/typecheck/TcAnnotations.hs
compiler/typecheck/TcArrows.hs
compiler/typecheck/TcBackpack.hs
compiler/typecheck/TcBinds.hs
compiler/typecheck/TcClassDcl.hs
compiler/typecheck/TcDefaults.hs
compiler/typecheck/TcDeriv.hs
compiler/typecheck/TcDerivUtils.hs
compiler/typecheck/TcEnv.hs
compiler/typecheck/TcEnv.hs-boot
compiler/typecheck/TcExpr.hs
compiler/typecheck/TcExpr.hs-boot
compiler/typecheck/TcForeign.hs
compiler/typecheck/TcGenDeriv.hs
compiler/typecheck/TcGenFunctor.hs
compiler/typecheck/TcGenGenerics.hs
compiler/typecheck/TcHsSyn.hs
compiler/typecheck/TcHsType.hs
compiler/typecheck/TcInstDcls.hs
compiler/typecheck/TcInstDcls.hs-boot
compiler/typecheck/TcMatches.hs
compiler/typecheck/TcMatches.hs-boot
compiler/typecheck/TcPat.hs
compiler/typecheck/TcPatSyn.hs
compiler/typecheck/TcPatSyn.hs-boot
compiler/typecheck/TcRnDriver.hs
compiler/typecheck/TcRnExports.hs
compiler/typecheck/TcRnTypes.hs
compiler/typecheck/TcRules.hs
compiler/typecheck/TcSigs.hs
compiler/typecheck/TcSimplify.hs
compiler/typecheck/TcSplice.hs
compiler/typecheck/TcSplice.hs-boot
compiler/typecheck/TcTyClsDecls.hs
compiler/typecheck/TcTyDecls.hs
compiler/typecheck/TcTypeable.hs
compiler/typecheck/TcUnify.hs
compiler/typecheck/TcUnify.hs-boot
compiler/typecheck/TcValidity.hs
docs/users_guide/8.4.1-notes.rst
ghc/GHCi/UI.hs
ghc/GHCi/UI/Info.hs
ghc/GHCi/UI/Monad.hs
testsuite/tests/ghc-api/annotations-literals/parsed.hs
testsuite/tests/ghc-api/annotations/parseTree.hs
testsuite/tests/ghc-api/annotations/stringSource.hs
testsuite/tests/ghc-api/annotations/t11430.hs
testsuite/tests/indexed-types/should_fail/T13784.hs
testsuite/tests/indexed-types/should_fail/T13784.stderr
testsuite/tests/quasiquotation/T7918.hs
utils/ghctags/Main.hs
utils/haddock

index a7e4db3..842c0df 100644 (file)
@@ -18,7 +18,6 @@ module BkpSyn (
     ) where
 
 import HsSyn
-import RdrName
 import SrcLoc
 import Outputable
 import Module
@@ -61,7 +60,7 @@ type LHsUnit n = Located (HsUnit n)
 -- or an include.
 data HsDeclType = ModuleD | SignatureD
 data HsUnitDecl n
-    = DeclD      HsDeclType (Located ModuleName) (Maybe (Located (HsModule RdrName)))
+    = DeclD   HsDeclType (Located ModuleName) (Maybe (Located (HsModule GhcPs)))
     | IncludeD   (IncludeDecl n)
 type LHsUnitDecl n = Located (HsUnitDecl n)
 
index a82e66b..6123bc8 100644 (file)
@@ -709,7 +709,7 @@ summariseRequirement pn mod_name = do
 summariseDecl :: PackageName
               -> HscSource
               -> Located ModuleName
-              -> Maybe (Located (HsModule RdrName))
+              -> Maybe (Located (HsModule GhcPs))
               -> BkpM ModSummary
 summariseDecl pn hsc_src (L _ modname) (Just hsmod) = hsModuleToModSummary pn hsc_src modname hsmod
 summariseDecl _pn hsc_src lmodname@(L loc modname) Nothing
@@ -736,7 +736,7 @@ summariseDecl _pn hsc_src lmodname@(L loc modname) Nothing
 hsModuleToModSummary :: PackageName
                      -> HscSource
                      -> ModuleName
-                     -> Located (HsModule RdrName)
+                     -> Located (HsModule GhcPs)
                      -> BkpM ModSummary
 hsModuleToModSummary pn hsc_src modname
                      hsmod = do
index 8234ccc..19bdba6 100644 (file)
@@ -134,7 +134,7 @@ data PmPat :: PatTy -> * where
             , pm_con_dicts   :: [EvVar]
             , pm_con_args    :: [PmPat t] } -> PmPat t
             -- For PmCon arguments' meaning see @ConPatOut@ in hsSyn/HsPat.hs
-  PmVar  :: { pm_var_id   :: Id    } -> PmPat t
+  PmVar  :: { pm_var_id   :: Id } -> PmPat t
   PmLit  :: { pm_lit_lit  :: PmLit } -> PmPat t -- See Note [Literals in PmPat]
   PmNLit :: { pm_lit_id   :: Id
             , pm_lit_not  :: [PmLit] } -> PmPat 'VA
@@ -254,9 +254,9 @@ instance Monoid PartialResult where
 data PmResult =
   PmResult {
       pmresultProvenance :: Provenance
-    , pmresultRedundant :: [Located [LPat Id]]
+    , pmresultRedundant :: [Located [LPat GhcTc]]
     , pmresultUncovered :: UncoveredCandidates
-    , pmresultInaccessible :: [Located [LPat Id]] }
+    , pmresultInaccessible :: [Located [LPat GhcTc]] }
 
 -- | Either a list of patterns that are not covered, or their type, in case we
 -- have no patterns at hand. Not having patterns at hand can arise when
@@ -289,7 +289,7 @@ uncoveredWithTy ty = PmResult FromBuiltin [] (TypeOfUncovered ty) []
 -}
 
 -- | Check a single pattern binding (let)
-checkSingle :: DynFlags -> DsMatchContext -> Id -> Pat Id -> DsM ()
+checkSingle :: DynFlags -> DsMatchContext -> Id -> Pat GhcTc -> DsM ()
 checkSingle dflags ctxt@(DsMatchContext _ locn) var p = do
   tracePmD "checkSingle" (vcat [ppr ctxt, ppr var, ppr p])
   mb_pm_res <- tryM (getResult (checkSingle' locn var p))
@@ -298,7 +298,7 @@ checkSingle dflags ctxt@(DsMatchContext _ locn) var p = do
     Right res -> dsPmWarn dflags ctxt res
 
 -- | Check a single pattern binding (let)
-checkSingle' :: SrcSpan -> Id -> Pat Id -> PmM PmResult
+checkSingle' :: SrcSpan -> Id -> Pat GhcTc -> PmM PmResult
 checkSingle' locn var p = do
   liftD resetPmIterDs -- set the iter-no to zero
   fam_insts <- liftD dsGetFamInstEnvs
@@ -316,7 +316,7 @@ checkSingle' locn var p = do
 
 -- | Check a matchgroup (case, functions, etc.)
 checkMatches :: DynFlags -> DsMatchContext
-             -> [Id] -> [LMatch Id (LHsExpr Id)] -> DsM ()
+             -> [Id] -> [LMatch GhcTc (LHsExpr GhcTc)] -> DsM ()
 checkMatches dflags ctxt vars matches = do
   tracePmD "checkMatches" (hang (vcat [ppr ctxt
                                , ppr vars
@@ -334,7 +334,7 @@ checkMatches dflags ctxt vars matches = do
 
 -- | Check a matchgroup (case, functions, etc.). To be called on a non-empty
 -- list of matches. For empty case expressions, use checkEmptyCase' instead.
-checkMatches' :: [Id] -> [LMatch Id (LHsExpr Id)] -> PmM PmResult
+checkMatches' :: [Id] -> [LMatch GhcTc (LHsExpr GhcTc)] -> PmM PmResult
 checkMatches' vars matches
   | null matches = panic "checkMatches': EmptyCase"
   | otherwise = do
@@ -348,11 +348,11 @@ checkMatches' vars matches
                  , pmresultUncovered    = UncoveredPatterns us
                  , pmresultInaccessible = map hsLMatchToLPats ds }
   where
-    go :: [LMatch Id (LHsExpr Id)] -> Uncovered
+    go :: [LMatch GhcTc (LHsExpr GhcTc)] -> Uncovered
        -> PmM (Provenance
-              , [LMatch Id (LHsExpr Id)]
+              , [LMatch GhcTc (LHsExpr GhcTc)]
               , Uncovered
-              , [LMatch Id (LHsExpr Id)])
+              , [LMatch GhcTc (LHsExpr GhcTc)])
     go []     missing = return (mempty, [], missing, [])
     go (m:ms) missing = do
       tracePm "checMatches': go" (ppr m $$ ppr missing)
@@ -544,14 +544,14 @@ mkListPatVec ty xs ys = [PmCon { pm_con_con = RealDataCon consDataCon
 {-# INLINE mkListPatVec #-}
 
 -- | Create a (non-overloaded) literal pattern
-mkLitPattern :: HsLit -> Pattern
+mkLitPattern :: HsLit GhcTc -> Pattern
 mkLitPattern lit = PmLit { pm_lit_lit = PmSLit lit }
 {-# INLINE mkLitPattern #-}
 
 -- -----------------------------------------------------------------------
 -- * Transform (Pat Id) into of (PmPat Id)
 
-translatePat :: FamInstEnvs -> Pat Id -> DsM PatVec
+translatePat :: FamInstEnvs -> Pat GhcTc -> DsM PatVec
 translatePat fam_insts pat = case pat of
   WildPat ty  -> mkPmVars [ty]
   VarPat  id  -> return [PmVar (unLoc id)]
@@ -661,15 +661,16 @@ translatePat fam_insts pat = case pat of
 
 -- | Translate an overloaded literal (see `tidyNPat' in deSugar/MatchLit.hs)
 translateNPat :: FamInstEnvs
-              -> HsOverLit Id -> Maybe (SyntaxExpr Id) -> Type -> DsM PatVec
+              -> HsOverLit GhcTc -> Maybe (SyntaxExpr GhcTc) -> Type
+              -> DsM PatVec
 translateNPat fam_insts (OverLit val False _ ty) mb_neg outer_ty
   | not type_change, isStringTy ty, HsIsString src s <- val, Nothing <- mb_neg
   = translatePat fam_insts (LitPat (HsString src s))
   | not type_change, isIntTy    ty, HsIntegral i <- val
   = translatePat fam_insts
                  (LitPat $ case mb_neg of
-                             Nothing -> HsInt i
-                             Just _  -> HsInt (negateIntegralLit i))
+                             Nothing -> HsInt def i
+                             Just _  -> HsInt def (negateIntegralLit i))
   | not type_change, isWordTy   ty, HsIntegral i <- val
   = translatePat fam_insts
                  (LitPat $ case mb_neg of
@@ -684,12 +685,12 @@ translateNPat _ ol mb_neg _
 
 -- | Translate a list of patterns (Note: each pattern is translated
 -- to a pattern vector but we do not concatenate the results).
-translatePatVec :: FamInstEnvs -> [Pat Id] -> DsM [PatVec]
+translatePatVec :: FamInstEnvs -> [Pat GhcTc] -> DsM [PatVec]
 translatePatVec fam_insts pats = mapM (translatePat fam_insts) pats
 
 -- | Translate a constructor pattern
 translateConPatVec :: FamInstEnvs -> [Type] -> [TyVar]
-                   -> ConLike -> HsConPatDetails Id -> DsM PatVec
+                   -> ConLike -> HsConPatDetails GhcTc -> DsM PatVec
 translateConPatVec fam_insts _univ_tys _ex_tvs _ (PrefixCon ps)
   = concat <$> translatePatVec fam_insts (map unLoc ps)
 translateConPatVec fam_insts _univ_tys _ex_tvs _ (InfixCon p1 p2)
@@ -744,13 +745,14 @@ translateConPatVec fam_insts  univ_tys  ex_tvs c (RecCon (HsRecFields fs _))
       | otherwise = subsetOf (x:xs) ys
 
 -- Translate a single match
-translateMatch :: FamInstEnvs -> LMatch Id (LHsExpr Id) -> DsM (PatVec,[PatVec])
+translateMatch :: FamInstEnvs -> LMatch GhcTc (LHsExpr GhcTc)
+               -> DsM (PatVec,[PatVec])
 translateMatch fam_insts (L _ (Match _ lpats _ grhss)) = do
   pats'   <- concat <$> translatePatVec fam_insts pats
   guards' <- mapM (translateGuards fam_insts) guards
   return (pats', guards')
   where
-    extractGuards :: LGRHS Id (LHsExpr Id) -> [GuardStmt Id]
+    extractGuards :: LGRHS GhcTc (LHsExpr GhcTc) -> [GuardStmt GhcTc]
     extractGuards (L _ (GRHS gs _)) = map unLoc gs
 
     pats   = map unLoc lpats
@@ -760,7 +762,7 @@ translateMatch fam_insts (L _ (Match _ lpats _ grhss)) = do
 -- * Transform source guards (GuardStmt Id) to PmPats (Pattern)
 
 -- | Translate a list of guard statements to a pattern vector
-translateGuards :: FamInstEnvs -> [GuardStmt Id] -> DsM PatVec
+translateGuards :: FamInstEnvs -> [GuardStmt GhcTc] -> DsM PatVec
 translateGuards fam_insts guards = do
   all_guards <- concat <$> mapM (translateGuard fam_insts) guards
   return (replace_unhandled all_guards)
@@ -800,7 +802,7 @@ cantFailPattern (PmGrd pv _e)
 cantFailPattern _ = False
 
 -- | Translate a guard statement to Pattern
-translateGuard :: FamInstEnvs -> GuardStmt Id -> DsM PatVec
+translateGuard :: FamInstEnvs -> GuardStmt GhcTc -> DsM PatVec
 translateGuard fam_insts guard = case guard of
   BodyStmt   e _ _ _ -> translateBoolGuard e
   LetStmt      binds -> translateLet (unLoc binds)
@@ -812,17 +814,17 @@ translateGuard fam_insts guard = case guard of
   ApplicativeStmt {} -> panic "translateGuard ApplicativeLastStmt"
 
 -- | Translate let-bindings
-translateLet :: HsLocalBinds Id -> DsM PatVec
+translateLet :: HsLocalBinds GhcTc -> DsM PatVec
 translateLet _binds = return []
 
 -- | Translate a pattern guard
-translateBind :: FamInstEnvs -> LPat Id -> LHsExpr Id -> DsM PatVec
+translateBind :: FamInstEnvs -> LPat GhcTc -> LHsExpr GhcTc -> DsM PatVec
 translateBind fam_insts (L _ p) e = do
   ps <- translatePat fam_insts p
   return [mkGuard ps (unLoc e)]
 
 -- | Translate a boolean guard
-translateBoolGuard :: LHsExpr Id -> DsM PatVec
+translateBoolGuard :: LHsExpr GhcTc -> DsM PatVec
 translateBoolGuard e
   | isJust (isTrueLHsExpr e) = return []
     -- The formal thing to do would be to generate (True <- True)
@@ -996,7 +998,7 @@ mkOneConFull x con = do
 -- * More smart constructors and fresh variable generation
 
 -- | Create a guard pattern
-mkGuard :: PatVec -> HsExpr Id -> Pattern
+mkGuard :: PatVec -> HsExpr GhcTc -> Pattern
 mkGuard pv e
   | all cantFailPattern pv = PmGrd pv expr
   | PmExprOther {} <- expr = fake_pat
@@ -1041,7 +1043,7 @@ mkPmId ty = getUniqueM >>= \unique ->
 -- | Generate a fresh term variable of a given and return it in two forms:
 -- * A variable pattern
 -- * A variable expression
-mkPmId2Forms :: Type -> DsM (Pattern, LHsExpr Id)
+mkPmId2Forms :: Type -> DsM (Pattern, LHsExpr GhcTc)
 mkPmId2Forms ty = do
   x <- mkPmId ty
   return (PmVar x, noLoc (HsVar (noLoc x)))
@@ -1508,9 +1510,9 @@ these constraints.
 -- When we go deeper to check e.g. e1 we record two equalities:
 -- (x ~ y), where y is the initial uncovered when checking (p1; .. ; pn)
 -- and (x ~ p1).
-genCaseTmCs2 :: Maybe (LHsExpr Id) -- Scrutinee
-             -> [Pat Id]           -- LHS       (should have length 1)
-             -> [Id]               -- MatchVars (should have length 1)
+genCaseTmCs2 :: Maybe (LHsExpr GhcTc) -- Scrutinee
+             -> [Pat GhcTc]           -- LHS       (should have length 1)
+             -> [Id]                  -- MatchVars (should have length 1)
              -> DsM (Bag SimpleEq)
 genCaseTmCs2 Nothing _ _ = return emptyBag
 genCaseTmCs2 (Just scr) [p] [var] = do
@@ -1524,7 +1526,7 @@ genCaseTmCs2 _ _ _ = panic "genCaseTmCs2: HsCase"
 --     case x of { matches }
 -- When checking matches we record that (x ~ y) where y is the initial
 -- uncovered. All matches will have to satisfy this equality.
-genCaseTmCs1 :: Maybe (LHsExpr Id) -> [Id] -> Bag SimpleEq
+genCaseTmCs1 :: Maybe (LHsExpr GhcTc) -> [Id] -> Bag SimpleEq
 genCaseTmCs1 Nothing     _    = emptyBag
 genCaseTmCs1 (Just scr) [var] = unitBag (var, lhsExprToPmExpr scr)
 genCaseTmCs1 _ _              = panic "genCaseTmCs1: HsCase"
@@ -1742,11 +1744,11 @@ pp_context singular (DsMatchContext kind _loc) msg rest_of_msg_fun
                                     \ pp -> ppr fun <+> pp)
              _                  -> (pprMatchContext kind, \ pp -> pp)
 
-ppr_pats :: HsMatchContext Name -> [Pat Id] -> SDoc
+ppr_pats :: HsMatchContext Name -> [Pat GhcTc] -> SDoc
 ppr_pats kind pats
   = sep [sep (map ppr pats), matchSeparator kind, text "..."]
 
-ppr_eqn :: (SDoc -> SDoc) -> HsMatchContext Name -> [LPat Id] -> SDoc
+ppr_eqn :: (SDoc -> SDoc) -> HsMatchContext Name -> [LPat GhcTc] -> SDoc
 ppr_eqn prefixF kind eqn = prefixF (ppr_pats kind (map unLoc eqn))
 
 ppr_constraint :: (SDoc,[PmLit]) -> SDoc
index 92002bf..16537bd 100644 (file)
@@ -68,8 +68,8 @@ addTicksToBinds
                                 -- isExportedId doesn't work yet (the desugarer
                                 -- hasn't set it), so we have to work from this set.
         -> [TyCon]              -- Type constructor in this module
-        -> LHsBinds Id
-        -> IO (LHsBinds Id, HpcInfo, Maybe ModBreaks)
+        -> LHsBinds GhcTc
+        -> IO (LHsBinds GhcTc, HpcInfo, Maybe ModBreaks)
 
 addTicksToBinds hsc_env mod mod_loc exports tyCons binds
   | let dflags = hsc_dflags hsc_env
@@ -118,7 +118,7 @@ addTicksToBinds hsc_env mod mod_loc exports tyCons binds
 
   | otherwise = return (binds, emptyHpcInfo False, Nothing)
 
-guessSourceFile :: LHsBinds Id -> FilePath -> FilePath
+guessSourceFile :: LHsBinds GhcTc -> FilePath -> FilePath
 guessSourceFile binds orig_file =
      -- Try look for a file generated from a .hsc file to a
      -- .hs file, by peeking ahead.
@@ -252,10 +252,10 @@ shouldTickPatBind density top_lev
 -- -----------------------------------------------------------------------------
 -- Adding ticks to bindings
 
-addTickLHsBinds :: LHsBinds Id -> TM (LHsBinds Id)
+addTickLHsBinds :: LHsBinds GhcTc -> TM (LHsBinds GhcTc)
 addTickLHsBinds = mapBagM addTickLHsBind
 
-addTickLHsBind :: LHsBind Id -> TM (LHsBind Id)
+addTickLHsBind :: LHsBind GhcTc -> TM (LHsBind GhcTc)
 addTickLHsBind (L pos bind@(AbsBinds { abs_binds   = binds,
                                        abs_exports = abs_exports })) = do
   withEnv add_exports $ do
@@ -419,7 +419,7 @@ bindTick density name pos fvs = do
 -- Decorate an LHsExpr with ticks
 
 -- selectively add ticks to interesting expressions
-addTickLHsExpr :: LHsExpr Id -> TM (LHsExpr Id)
+addTickLHsExpr :: LHsExpr GhcTc -> TM (LHsExpr GhcTc)
 addTickLHsExpr e@(L pos e0) = do
   d <- getDensity
   case d of
@@ -435,7 +435,7 @@ addTickLHsExpr e@(L pos e0) = do
 -- We always consider these to be breakpoints, unless the expression is a 'let'
 -- (because the body will definitely have a tick somewhere).  ToDo: perhaps
 -- we should treat 'case' and 'if' the same way?
-addTickLHsExprRHS :: LHsExpr Id -> TM (LHsExpr Id)
+addTickLHsExprRHS :: LHsExpr GhcTc -> TM (LHsExpr GhcTc)
 addTickLHsExprRHS e@(L pos e0) = do
   d <- getDensity
   case d of
@@ -452,7 +452,7 @@ addTickLHsExprRHS e@(L pos e0) = do
 --    let binds in [], ( [] )
 -- we never tick these if we're doing HPC, but otherwise
 -- we treat it like an ordinary expression.
-addTickLHsExprEvalInner :: LHsExpr Id -> TM (LHsExpr Id)
+addTickLHsExprEvalInner :: LHsExpr GhcTc -> TM (LHsExpr GhcTc)
 addTickLHsExprEvalInner e = do
    d <- getDensity
    case d of
@@ -464,7 +464,7 @@ addTickLHsExprEvalInner e = do
 -- want to tick the body, even if it is not a redex.  See test
 -- break012.  This gives the user the opportunity to inspect the
 -- values of the let-bound variables.
-addTickLHsExprLetBody :: LHsExpr Id -> TM (LHsExpr Id)
+addTickLHsExprLetBody :: LHsExpr GhcTc -> TM (LHsExpr GhcTc)
 addTickLHsExprLetBody e@(L pos e0) = do
   d <- getDensity
   case d of
@@ -478,32 +478,32 @@ addTickLHsExprLetBody e@(L pos e0) = do
 -- version of addTick that does not actually add a tick,
 -- because the scope of this tick is completely subsumed by
 -- another.
-addTickLHsExprNever :: LHsExpr Id -> TM (LHsExpr Id)
+addTickLHsExprNever :: LHsExpr GhcTc -> TM (LHsExpr GhcTc)
 addTickLHsExprNever (L pos e0) = do
     e1 <- addTickHsExpr e0
     return $ L pos e1
 
 -- general heuristic: expressions which do not denote values are good
 -- break points
-isGoodBreakExpr :: HsExpr Id -> Bool
+isGoodBreakExpr :: HsExpr GhcTc -> Bool
 isGoodBreakExpr (HsApp {})        = True
 isGoodBreakExpr (HsAppTypeOut {}) = True
 isGoodBreakExpr (OpApp {})        = True
 isGoodBreakExpr _other            = False
 
-isCallSite :: HsExpr Id -> Bool
+isCallSite :: HsExpr GhcTc -> Bool
 isCallSite HsApp{}        = True
 isCallSite HsAppTypeOut{} = True
 isCallSite OpApp{}        = True
 isCallSite _ = False
 
-addTickLHsExprOptAlt :: Bool -> LHsExpr Id -> TM (LHsExpr Id)
+addTickLHsExprOptAlt :: Bool -> LHsExpr GhcTc -> TM (LHsExpr GhcTc)
 addTickLHsExprOptAlt oneOfMany (L pos e0)
   = ifDensity TickForCoverage
         (allocTickBox (ExpBox oneOfMany) False False pos $ addTickHsExpr e0)
         (addTickLHsExpr (L pos e0))
 
-addBinTickLHsExpr :: (Bool -> BoxLabel) -> LHsExpr Id -> TM (LHsExpr Id)
+addBinTickLHsExpr :: (Bool -> BoxLabel) -> LHsExpr GhcTc -> TM (LHsExpr GhcTc)
 addBinTickLHsExpr boxLabel (L pos e0)
   = ifDensity TickForCoverage
         (allocBinTickBox boxLabel pos $ addTickHsExpr e0)
@@ -515,7 +515,7 @@ addBinTickLHsExpr boxLabel (L pos e0)
 -- (Whether to put a tick around the whole expression was already decided,
 -- in the addTickLHsExpr family of functions.)
 
-addTickHsExpr :: HsExpr Id -> TM (HsExpr Id)
+addTickHsExpr :: HsExpr GhcTc -> TM (HsExpr GhcTc)
 addTickHsExpr e@(HsVar (L _ id)) = do freeVar id; return e
 addTickHsExpr (HsUnboundVar {})  = panic "addTickHsExpr.HsUnboundVar"
 addTickHsExpr e@(HsConLikeOut con)
@@ -668,24 +668,27 @@ addTickHsExpr (ExprWithTySigOut e ty) =
 -- Others should never happen in expression content.
 addTickHsExpr e  = pprPanic "addTickHsExpr" (ppr e)
 
-addTickTupArg :: LHsTupArg Id -> TM (LHsTupArg Id)
+addTickTupArg :: LHsTupArg GhcTc -> TM (LHsTupArg GhcTc)
 addTickTupArg (L l (Present e))  = do { e' <- addTickLHsExpr e
                                       ; return (L l (Present e')) }
 addTickTupArg (L l (Missing ty)) = return (L l (Missing ty))
 
-addTickMatchGroup :: Bool{-is lambda-} -> MatchGroup Id (LHsExpr Id) -> TM (MatchGroup Id (LHsExpr Id))
+addTickMatchGroup :: Bool{-is lambda-} -> MatchGroup GhcTc (LHsExpr GhcTc)
+                  -> TM (MatchGroup GhcTc (LHsExpr GhcTc))
 addTickMatchGroup is_lam mg@(MG { mg_alts = L l matches }) = do
   let isOneOfMany = matchesOneOfMany matches
   matches' <- mapM (liftL (addTickMatch isOneOfMany is_lam)) matches
   return $ mg { mg_alts = L l matches' }
 
-addTickMatch :: Bool -> Bool -> Match Id (LHsExpr Id) -> TM (Match Id (LHsExpr Id))
+addTickMatch :: Bool -> Bool -> Match GhcTc (LHsExpr GhcTc)
+             -> TM (Match GhcTc (LHsExpr GhcTc))
 addTickMatch isOneOfMany isLambda (Match mf pats opSig gRHSs) =
   bindLocals (collectPatsBinders pats) $ do
     gRHSs' <- addTickGRHSs isOneOfMany isLambda gRHSs
     return $ Match mf pats opSig gRHSs'
 
-addTickGRHSs :: Bool -> Bool -> GRHSs Id (LHsExpr Id) -> TM (GRHSs Id (LHsExpr Id))
+addTickGRHSs :: Bool -> Bool -> GRHSs GhcTc (LHsExpr GhcTc)
+             -> TM (GRHSs GhcTc (LHsExpr GhcTc))
 addTickGRHSs isOneOfMany isLambda (GRHSs guarded (L l local_binds)) = do
   bindLocals binders $ do
     local_binds' <- addTickHsLocalBinds local_binds
@@ -694,13 +697,14 @@ addTickGRHSs isOneOfMany isLambda (GRHSs guarded (L l local_binds)) = do
   where
     binders = collectLocalBinders local_binds
 
-addTickGRHS :: Bool -> Bool -> GRHS Id (LHsExpr Id) -> TM (GRHS Id (LHsExpr Id))
+addTickGRHS :: Bool -> Bool -> GRHS GhcTc (LHsExpr GhcTc)
+            -> TM (GRHS GhcTc (LHsExpr GhcTc))
 addTickGRHS isOneOfMany isLambda (GRHS stmts expr) = do
   (stmts',expr') <- addTickLStmts' (Just $ BinBox $ GuardBinBox) stmts
                         (addTickGRHSBody isOneOfMany isLambda expr)
   return $ GRHS stmts' expr'
 
-addTickGRHSBody :: Bool -> Bool -> LHsExpr Id -> TM (LHsExpr Id)
+addTickGRHSBody :: Bool -> Bool -> LHsExpr GhcTc -> TM (LHsExpr GhcTc)
 addTickGRHSBody isOneOfMany isLambda expr@(L pos e0) = do
   d <- getDensity
   case d of
@@ -712,20 +716,22 @@ addTickGRHSBody isOneOfMany isLambda expr@(L pos e0) = do
     _otherwise ->
        addTickLHsExprRHS expr
 
-addTickLStmts :: (Maybe (Bool -> BoxLabel)) -> [ExprLStmt Id] -> TM [ExprLStmt Id]
+addTickLStmts :: (Maybe (Bool -> BoxLabel)) -> [ExprLStmt GhcTc]
+              -> TM [ExprLStmt GhcTc]
 addTickLStmts isGuard stmts = do
   (stmts, _) <- addTickLStmts' isGuard stmts (return ())
   return stmts
 
-addTickLStmts' :: (Maybe (Bool -> BoxLabel)) -> [ExprLStmt Id] -> TM a
-               -> TM ([ExprLStmt Id], a)
+addTickLStmts' :: (Maybe (Bool -> BoxLabel)) -> [ExprLStmt GhcTc] -> TM a
+               -> TM ([ExprLStmt GhcTc], a)
 addTickLStmts' isGuard lstmts res
   = bindLocals (collectLStmtsBinders lstmts) $
     do { lstmts' <- mapM (liftL (addTickStmt isGuard)) lstmts
        ; a <- res
        ; return (lstmts', a) }
 
-addTickStmt :: (Maybe (Bool -> BoxLabel)) -> Stmt Id (LHsExpr Id) -> TM (Stmt Id (LHsExpr Id))
+addTickStmt :: (Maybe (Bool -> BoxLabel)) -> Stmt GhcTc (LHsExpr GhcTc)
+            -> TM (Stmt GhcTc (LHsExpr GhcTc))
 addTickStmt _isGuard (LastStmt e noret ret) = do
         liftM3 LastStmt
                 (addTickLHsExpr e)
@@ -778,13 +784,13 @@ addTickStmt isGuard stmt@(RecStmt {})
        ; return (stmt { recS_stmts = stmts', recS_ret_fn = ret'
                       , recS_mfix_fn = mfix', recS_bind_fn = bind' }) }
 
-addTick :: Maybe (Bool -> BoxLabel) -> LHsExpr Id -> TM (LHsExpr Id)
+addTick :: Maybe (Bool -> BoxLabel) -> LHsExpr GhcTc -> TM (LHsExpr GhcTc)
 addTick isGuard e | Just fn <- isGuard = addBinTickLHsExpr fn e
                   | otherwise          = addTickLHsExprRHS e
 
 addTickApplicativeArg
-  :: Maybe (Bool -> BoxLabel) -> (SyntaxExpr Id, ApplicativeArg Id Id)
-  -> TM (SyntaxExpr Id, ApplicativeArg Id Id)
+  :: Maybe (Bool -> BoxLabel) -> (SyntaxExpr GhcTc, ApplicativeArg GhcTc GhcTc)
+  -> TM (SyntaxExpr GhcTc, ApplicativeArg GhcTc GhcTc)
 addTickApplicativeArg isGuard (op, arg) =
   liftM2 (,) (addTickSyntaxExpr hpcSrcSpan op) (addTickArg arg)
  where
@@ -796,15 +802,15 @@ addTickApplicativeArg isGuard (op, arg) =
       <*> (unLoc <$> addTickLHsExpr (L hpcSrcSpan ret))
       <*> addTickLPat pat
 
-addTickStmtAndBinders :: Maybe (Bool -> BoxLabel) -> ParStmtBlock Id Id
-                      -> TM (ParStmtBlock Id Id)
+addTickStmtAndBinders :: Maybe (Bool -> BoxLabel) -> ParStmtBlock GhcTc GhcTc
+                      -> TM (ParStmtBlock GhcTc GhcTc)
 addTickStmtAndBinders isGuard (ParStmtBlock stmts ids returnExpr) =
     liftM3 ParStmtBlock
         (addTickLStmts isGuard stmts)
         (return ids)
         (addTickSyntaxExpr hpcSrcSpan returnExpr)
 
-addTickHsLocalBinds :: HsLocalBinds Id -> TM (HsLocalBinds Id)
+addTickHsLocalBinds :: HsLocalBinds GhcTc -> TM (HsLocalBinds GhcTc)
 addTickHsLocalBinds (HsValBinds binds) =
         liftM HsValBinds
                 (addTickHsValBinds binds)
@@ -813,7 +819,7 @@ addTickHsLocalBinds (HsIPBinds binds)  =
                 (addTickHsIPBinds binds)
 addTickHsLocalBinds (EmptyLocalBinds)  = return EmptyLocalBinds
 
-addTickHsValBinds :: HsValBindsLR Id a -> TM (HsValBindsLR Id b)
+addTickHsValBinds :: HsValBindsLR GhcTc a -> TM (HsValBindsLR GhcTc b)
 addTickHsValBinds (ValBindsOut binds sigs) =
         liftM2 ValBindsOut
                 (mapM (\ (rec,binds') ->
@@ -824,28 +830,28 @@ addTickHsValBinds (ValBindsOut binds sigs) =
                 (return sigs)
 addTickHsValBinds _ = panic "addTickHsValBinds"
 
-addTickHsIPBinds :: HsIPBinds Id -> TM (HsIPBinds Id)
+addTickHsIPBinds :: HsIPBinds GhcTc -> TM (HsIPBinds GhcTc)
 addTickHsIPBinds (IPBinds ipbinds dictbinds) =
         liftM2 IPBinds
                 (mapM (liftL (addTickIPBind)) ipbinds)
                 (return dictbinds)
 
-addTickIPBind :: IPBind Id -> TM (IPBind Id)
+addTickIPBind :: IPBind GhcTc -> TM (IPBind GhcTc)
 addTickIPBind (IPBind nm e) =
         liftM2 IPBind
                 (return nm)
                 (addTickLHsExpr e)
 
 -- There is no location here, so we might need to use a context location??
-addTickSyntaxExpr :: SrcSpan -> SyntaxExpr Id -> TM (SyntaxExpr Id)
+addTickSyntaxExpr :: SrcSpan -> SyntaxExpr GhcTc -> TM (SyntaxExpr GhcTc)
 addTickSyntaxExpr pos syn@(SyntaxExpr { syn_expr = x }) = do
         L _ x' <- addTickLHsExpr (L pos x)
         return $ syn { syn_expr = x' }
 -- we do not walk into patterns.
-addTickLPat :: LPat Id -> TM (LPat Id)
+addTickLPat :: LPat GhcTc -> TM (LPat GhcTc)
 addTickLPat pat = return pat
 
-addTickHsCmdTop :: HsCmdTop Id -> TM (HsCmdTop Id)
+addTickHsCmdTop :: HsCmdTop GhcTc -> TM (HsCmdTop GhcTc)
 addTickHsCmdTop (HsCmdTop cmd tys ty syntaxtable) =
         liftM4 HsCmdTop
                 (addTickLHsCmd cmd)
@@ -853,12 +859,12 @@ addTickHsCmdTop (HsCmdTop cmd tys ty syntaxtable) =
                 (return ty)
                 (return syntaxtable)
 
-addTickLHsCmd ::  LHsCmd Id -> TM (LHsCmd Id)
+addTickLHsCmd ::  LHsCmd GhcTc -> TM (LHsCmd GhcTc)
 addTickLHsCmd (L pos c0) = do
         c1 <- addTickHsCmd c0
         return $ L pos c1
 
-addTickHsCmd :: HsCmd Id -> TM (HsCmd Id)
+addTickHsCmd :: HsCmd GhcTc -> TM (HsCmd GhcTc)
 addTickHsCmd (HsCmdLam matchgroup) =
         liftM HsCmdLam (addTickCmdMatchGroup matchgroup)
 addTickHsCmd (HsCmdApp c e) =
@@ -910,18 +916,19 @@ addTickHsCmd (HsCmdWrap w cmd)
 -- Others should never happen in a command context.
 --addTickHsCmd e  = pprPanic "addTickHsCmd" (ppr e)
 
-addTickCmdMatchGroup :: MatchGroup Id (LHsCmd Id) -> TM (MatchGroup Id (LHsCmd Id))
+addTickCmdMatchGroup :: MatchGroup GhcTc (LHsCmd GhcTc)
+                     -> TM (MatchGroup GhcTc (LHsCmd GhcTc))
 addTickCmdMatchGroup mg@(MG { mg_alts = L l matches }) = do
   matches' <- mapM (liftL addTickCmdMatch) matches
   return $ mg { mg_alts = L l matches' }
 
-addTickCmdMatch :: Match Id (LHsCmd Id) -> TM (Match Id (LHsCmd Id))
+addTickCmdMatch :: Match GhcTc (LHsCmd GhcTc) -> TM (Match GhcTc (LHsCmd GhcTc))
 addTickCmdMatch (Match mf pats opSig gRHSs) =
   bindLocals (collectPatsBinders pats) $ do
     gRHSs' <- addTickCmdGRHSs gRHSs
     return $ Match mf pats opSig gRHSs'
 
-addTickCmdGRHSs :: GRHSs Id (LHsCmd Id) -> TM (GRHSs Id (LHsCmd Id))
+addTickCmdGRHSs :: GRHSs GhcTc (LHsCmd GhcTc) -> TM (GRHSs GhcTc (LHsCmd GhcTc))
 addTickCmdGRHSs (GRHSs guarded (L l local_binds)) = do
   bindLocals binders $ do
     local_binds' <- addTickHsLocalBinds local_binds
@@ -930,7 +937,7 @@ addTickCmdGRHSs (GRHSs guarded (L l local_binds)) = do
   where
     binders = collectLocalBinders local_binds
 
-addTickCmdGRHS :: GRHS Id (LHsCmd Id) -> TM (GRHS Id (LHsCmd Id))
+addTickCmdGRHS :: GRHS GhcTc (LHsCmd GhcTc) -> TM (GRHS GhcTc (LHsCmd GhcTc))
 -- The *guards* are *not* Cmds, although the body is
 -- C.f. addTickGRHS for the BinBox stuff
 addTickCmdGRHS (GRHS stmts cmd)
@@ -938,12 +945,14 @@ addTickCmdGRHS (GRHS stmts cmd)
                                    stmts (addTickLHsCmd cmd)
        ; return $ GRHS stmts' expr' }
 
-addTickLCmdStmts :: [LStmt Id (LHsCmd Id)] -> TM [LStmt Id (LHsCmd Id)]
+addTickLCmdStmts :: [LStmt GhcTc (LHsCmd GhcTc)]
+                 -> TM [LStmt GhcTc (LHsCmd GhcTc)]
 addTickLCmdStmts stmts = do
   (stmts, _) <- addTickLCmdStmts' stmts (return ())
   return stmts
 
-addTickLCmdStmts' :: [LStmt Id (LHsCmd Id)] -> TM a -> TM ([LStmt Id (LHsCmd Id)], a)
+addTickLCmdStmts' :: [LStmt GhcTc (LHsCmd GhcTc)] -> TM a
+                  -> TM ([LStmt GhcTc (LHsCmd GhcTc)], a)
 addTickLCmdStmts' lstmts res
   = bindLocals binders $ do
         lstmts' <- mapM (liftL addTickCmdStmt) lstmts
@@ -952,7 +961,7 @@ addTickLCmdStmts' lstmts res
   where
         binders = collectLStmtsBinders lstmts
 
-addTickCmdStmt :: Stmt Id (LHsCmd Id) -> TM (Stmt Id (LHsCmd Id))
+addTickCmdStmt :: Stmt GhcTc (LHsCmd GhcTc) -> TM (Stmt GhcTc (LHsCmd GhcTc))
 addTickCmdStmt (BindStmt pat c bind fail ty) = do
         liftM5 BindStmt
                 (addTickLPat pat)
@@ -987,18 +996,19 @@ addTickCmdStmt ApplicativeStmt{} =
 -- Others should never happen in a command context.
 addTickCmdStmt stmt  = pprPanic "addTickHsCmd" (ppr stmt)
 
-addTickHsRecordBinds :: HsRecordBinds Id -> TM (HsRecordBinds Id)
+addTickHsRecordBinds :: HsRecordBinds GhcTc -> TM (HsRecordBinds GhcTc)
 addTickHsRecordBinds (HsRecFields fields dd)
   = do  { fields' <- mapM addTickHsRecField fields
         ; return (HsRecFields fields' dd) }
 
-addTickHsRecField :: LHsRecField' id (LHsExpr Id) -> TM (LHsRecField' id (LHsExpr Id))
+addTickHsRecField :: LHsRecField' id (LHsExpr GhcTc)
+                  -> TM (LHsRecField' id (LHsExpr GhcTc))
 addTickHsRecField (L l (HsRecField id expr pun))
         = do { expr' <- addTickLHsExpr expr
              ; return (L l (HsRecField id expr' pun)) }
 
 
-addTickArithSeqInfo :: ArithSeqInfo Id -> TM (ArithSeqInfo Id)
+addTickArithSeqInfo :: ArithSeqInfo GhcTc -> TM (ArithSeqInfo GhcTc)
 addTickArithSeqInfo (From e1) =
         liftM From
                 (addTickLHsExpr e1)
@@ -1174,8 +1184,8 @@ isBlackListed pos = TM $ \ env st ->
 
 -- the tick application inherits the source position of its
 -- expression argument to support nested box allocations
-allocTickBox :: BoxLabel -> Bool -> Bool -> SrcSpan -> TM (HsExpr Id)
-             -> TM (LHsExpr Id)
+allocTickBox :: BoxLabel -> Bool -> Bool -> SrcSpan -> TM (HsExpr GhcTc)
+             -> TM (LHsExpr GhcTc)
 allocTickBox boxLabel countEntries topOnly pos m =
   ifGoodTickSrcSpan pos (do
     (fvs, e) <- getFreeVars m
@@ -1246,8 +1256,8 @@ mkTickish boxLabel countEntries topOnly pos fvs decl_path = do
     _otherwise -> panic "mkTickish: bad source span!"
 
 
-allocBinTickBox :: (Bool -> BoxLabel) -> SrcSpan -> TM (HsExpr Id)
-                -> TM (LHsExpr Id)
+allocBinTickBox :: (Bool -> BoxLabel) -> SrcSpan -> TM (HsExpr GhcTc)
+                -> TM (LHsExpr GhcTc)
 allocBinTickBox boxLabel pos m = do
   env <- getEnv
   case tickishType env of
@@ -1257,8 +1267,8 @@ allocBinTickBox boxLabel pos m = do
                      (return e)
     _other   -> allocTickBox (ExpBox False) False False pos m
 
-mkBinTickBoxHpc :: (Bool -> BoxLabel) -> SrcSpan -> LHsExpr Id
-                -> TM (LHsExpr Id)
+mkBinTickBoxHpc :: (Bool -> BoxLabel) -> SrcSpan -> LHsExpr GhcTc
+                -> TM (LHsExpr GhcTc)
 mkBinTickBoxHpc boxLabel pos e =
  TM $ \ env st ->
   let meT = (pos,declPath env, [],boxLabel True)
@@ -1291,7 +1301,7 @@ mkHpcPos _ = panic "bad source span; expected such spans to be filtered out"
 hpcSrcSpan :: SrcSpan
 hpcSrcSpan = mkGeneralSrcSpan (fsLit "Haskell Program Coverage internals")
 
-matchesOneOfMany :: [LMatch Id body] -> Bool
+matchesOneOfMany :: [LMatch GhcTc body] -> Bool
 matchesOneOfMany lmatches = sum (map matchCount lmatches) > 1
   where
         matchCount (L _ (Match _ _pats _ty (GRHSs grhss _binds))) = length grhss
index 0d8965a..3d8a28f 100644 (file)
@@ -7,6 +7,7 @@ The Desugarer: turning HsSyn into Core.
 -}
 
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE TypeFamilies #-}
 
 module Desugar (
     -- * Desugaring operations
@@ -250,7 +251,7 @@ So we pull out the type/coercion variables (which are in dependency order),
 and Rec the rest.
 -}
 
-deSugarExpr :: HscEnv -> LHsExpr Id -> IO (Messages, Maybe CoreExpr)
+deSugarExpr :: HscEnv -> LHsExpr GhcTc -> IO (Messages, Maybe CoreExpr)
 
 deSugarExpr hsc_env tc_expr = do {
          let dflags = hsc_dflags hsc_env
@@ -362,7 +363,7 @@ Reason
 ************************************************************************
 -}
 
-dsRule :: LRuleDecl Id -> DsM (Maybe CoreRule)
+dsRule :: LRuleDecl GhcTc -> DsM (Maybe CoreRule)
 dsRule (L loc (HsRule name rule_act vars lhs _tv_lhs rhs _fv_rhs))
   = putSrcSpanDs loc $
     do  { let bndrs' = [var | L _ (RuleBndr (L _ var)) <- vars]
@@ -541,7 +542,7 @@ subsequent transformations could fire.
 ************************************************************************
 -}
 
-dsVect :: LVectDecl Id -> DsM CoreVect
+dsVect :: LVectDecl GhcTc -> DsM CoreVect
 dsVect (L loc (HsVect _ (L _ v) rhs))
   = putSrcSpanDs loc $
     do { rhs' <- dsLExpr rhs
index 4fe43eb..fb16d53 100644 (file)
@@ -7,6 +7,7 @@ Desugaring arrow commands
 -}
 
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE TypeFamilies #-}
 
 module DsArrows ( dsProcExpr ) where
 
@@ -37,7 +38,6 @@ import MkCore
 import DsBinds (dsHsWrapper)
 
 import Name
-import Var
 import Id
 import ConLike
 import TysWiredIn
@@ -57,7 +57,7 @@ data DsCmdEnv = DsCmdEnv {
         arr_id, compose_id, first_id, app_id, choice_id, loop_id :: CoreExpr
     }
 
-mkCmdEnv :: CmdSyntaxTable Id -> DsM ([CoreBind], DsCmdEnv)
+mkCmdEnv :: CmdSyntaxTable GhcTc -> DsM ([CoreBind], DsCmdEnv)
 -- See Note [CmdSyntaxTable] in HsExpr
 mkCmdEnv tc_meths
   = do { (meth_binds, prs) <- mapAndUnzipM mk_bind tc_meths
@@ -295,7 +295,7 @@ matchVarStack (param_id:param_ids) stack_id body = do
     pair_id <- newSysLocalDs (mkCorePairTy (idType param_id) (idType tail_id))
     return (pair_id, coreCasePair pair_id param_id tail_id tail_code)
 
-mkHsEnvStackExpr :: [Id] -> Id -> LHsExpr Id
+mkHsEnvStackExpr :: [Id] -> Id -> LHsExpr GhcTc
 mkHsEnvStackExpr env_ids stack_id
   = mkLHsTupleExpr [mkLHsVarTuple env_ids, nlHsVar stack_id]
 
@@ -308,8 +308,8 @@ mkHsEnvStackExpr env_ids stack_id
 --              where (xs) is the tuple of variables bound by p
 
 dsProcExpr
-        :: LPat Id
-        -> LHsCmdTop Id
+        :: LPat GhcTc
+        -> LHsCmdTop GhcTc
         -> DsM CoreExpr
 dsProcExpr pat (L _ (HsCmdTop cmd _unitTy cmd_ty ids)) = do
     (meth_binds, meth_ids) <- mkCmdEnv ids
@@ -337,7 +337,7 @@ to an expression e such that
         D |- e :: a (xs, stk) t
 -}
 
-dsLCmd :: DsCmdEnv -> IdSet -> Type -> Type -> LHsCmd Id -> [Id]
+dsLCmd :: DsCmdEnv -> IdSet -> Type -> Type -> LHsCmd GhcTc -> [Id]
        -> DsM (CoreExpr, DIdSet)
 dsLCmd ids local_vars stk_ty res_ty cmd env_ids
   = dsCmd ids local_vars stk_ty res_ty (unLoc cmd) env_ids
@@ -346,8 +346,8 @@ dsCmd   :: DsCmdEnv             -- arrow combinators
         -> IdSet                -- set of local vars available to this command
         -> Type                 -- type of the stack (right-nested tuple)
         -> Type                 -- return type of the command
-        -> HsCmd Id             -- command to desugar
-        -> [Id]                 -- list of vars in the input to this command
+        -> HsCmd GhcTc           -- command to desugar
+        -> [Id]           -- list of vars in the input to this command
                                 -- This is typically fed back,
                                 -- so don't pull on it too early
         -> DsM (CoreExpr,       -- desugared expression
@@ -676,8 +676,8 @@ dsCmd _ _ _ _ _ c = pprPanic "dsCmd" (ppr c)
 
 dsTrimCmdArg
         :: IdSet                -- set of local vars available to this command
-        -> [Id]                 -- list of vars in the input to this command
-        -> LHsCmdTop Id         -- command argument to desugar
+        -> [Id]           -- list of vars in the input to this command
+        -> LHsCmdTop GhcTc       -- command argument to desugar
         -> DsM (CoreExpr,       -- desugared expression
                 DIdSet)         -- subset of local vars that occur free
 dsTrimCmdArg local_vars env_ids (L _ (HsCmdTop cmd stack_ty cmd_ty ids)) = do
@@ -700,7 +700,7 @@ dsfixCmd
         -> IdSet                -- set of local vars available to this command
         -> Type                 -- type of the stack (right-nested tuple)
         -> Type                 -- return type of the command
-        -> LHsCmd Id            -- command to desugar
+        -> LHsCmd GhcTc         -- command to desugar
         -> DsM (CoreExpr,       -- desugared expression
                 DIdSet,         -- subset of local vars that occur free
                 [Id])           -- the same local vars as a list, fed back
@@ -733,7 +733,7 @@ Translation of command judgements of the form
 dsCmdDo :: DsCmdEnv             -- arrow combinators
         -> IdSet                -- set of local vars available to this statement
         -> Type                 -- return type of the statement
-        -> [CmdLStmt Id]        -- statements to desugar
+        -> [CmdLStmt GhcTc]     -- statements to desugar
         -> [Id]                 -- list of vars in the input to this statement
                                 -- This is typically fed back,
                                 -- so don't pull on it too early
@@ -782,7 +782,7 @@ as an arrow from one tuple type to another.  A statement sequence is
 translated to a composition of such arrows.
 -}
 
-dsCmdLStmt :: DsCmdEnv -> IdSet -> [Id] -> CmdLStmt Id -> [Id]
+dsCmdLStmt :: DsCmdEnv -> IdSet -> [Id] -> CmdLStmt GhcTc -> [Id]
            -> DsM (CoreExpr, DIdSet)
 dsCmdLStmt ids local_vars out_ids cmd env_ids
   = dsCmdStmt ids local_vars out_ids (unLoc cmd) env_ids
@@ -791,7 +791,7 @@ dsCmdStmt
         :: DsCmdEnv             -- arrow combinators
         -> IdSet                -- set of local vars available to this statement
         -> [Id]                 -- list of vars in the output of this statement
-        -> CmdStmt Id           -- statement to desugar
+        -> CmdStmt GhcTc        -- statement to desugar
         -> [Id]                 -- list of vars in the input to this statement
                                 -- This is typically fed back,
                                 -- so don't pull on it too early
@@ -973,11 +973,11 @@ dsCmdStmt _ _ _ _ s = pprPanic "dsCmdStmt" (ppr s)
 dsRecCmd
         :: DsCmdEnv             -- arrow combinators
         -> IdSet                -- set of local vars available to this statement
-        -> [CmdLStmt Id]        -- list of statements inside the RecCmd
+        -> [CmdLStmt GhcTc]     -- list of statements inside the RecCmd
         -> [Id]                 -- list of vars defined here and used later
-        -> [HsExpr Id]          -- expressions corresponding to later_ids
+        -> [HsExpr GhcTc]       -- expressions corresponding to later_ids
         -> [Id]                 -- list of vars fed back through the loop
-        -> [HsExpr Id]          -- expressions corresponding to rec_ids
+        -> [HsExpr GhcTc]       -- expressions corresponding to rec_ids
         -> DsM (CoreExpr,       -- desugared statement
                 DIdSet,         -- subset of local vars that occur free
                 [Id])           -- same local vars as a list
@@ -1051,7 +1051,7 @@ dsfixCmdStmts
         :: DsCmdEnv             -- arrow combinators
         -> IdSet                -- set of local vars available to this statement
         -> [Id]                 -- output vars of these statements
-        -> [CmdLStmt Id]        -- statements to desugar
+        -> [CmdLStmt GhcTc]     -- statements to desugar
         -> DsM (CoreExpr,       -- desugared expression
                 DIdSet,         -- subset of local vars that occur free
                 [Id])           -- same local vars as a list
@@ -1065,7 +1065,7 @@ dsCmdStmts
         :: DsCmdEnv             -- arrow combinators
         -> IdSet                -- set of local vars available to this statement
         -> [Id]                 -- output vars of these statements
-        -> [CmdLStmt Id]        -- statements to desugar
+        -> [CmdLStmt GhcTc]     -- statements to desugar
         -> [Id]                 -- list of vars in the input to these statements
         -> DsM (CoreExpr,       -- desugared expression
                 DIdSet)         -- subset of local vars that occur free
@@ -1092,7 +1092,7 @@ dsCmdStmts _ _ _ [] _ = panic "dsCmdStmts []"
 
 matchSimplys :: [CoreExpr]              -- Scrutinees
              -> HsMatchContext Name     -- Match kind
-             -> [LPat Id]               -- Patterns they should match
+             -> [LPat GhcTc]            -- Patterns they should match
              -> CoreExpr                -- Return this if they all match
              -> CoreExpr                -- Return this if they don't
              -> DsM CoreExpr
@@ -1104,7 +1104,8 @@ matchSimplys _ _ _ _ _ = panic "matchSimplys"
 
 -- List of leaf expressions, with set of variables bound in each
 
-leavesMatch :: LMatch Id (Located (body Id)) -> [(Located (body Id), IdSet)]
+leavesMatch :: LMatch GhcTc (Located (body GhcTc))
+            -> [(Located (body GhcTc), IdSet)]
 leavesMatch (L _ (Match _ pats _ (GRHSs grhss (L _ binds))))
   = let
         defined_vars = mkVarSet (collectPatsBinders pats)
@@ -1120,10 +1121,10 @@ leavesMatch (L _ (Match _ pats _ (GRHSs grhss (L _ binds))))
 
 replaceLeavesMatch
         :: Type                                 -- new result type
-        -> [Located (body' Id)]                 -- replacement leaf expressions of that type
-        -> LMatch Id (Located (body Id))        -- the matches of a case command
-        -> ([Located (body' Id)],               -- remaining leaf expressions
-            LMatch Id (Located (body' Id)))     -- updated match
+        -> [Located (body' GhcTc)] -- replacement leaf expressions of that type
+        -> LMatch GhcTc (Located (body GhcTc))  -- the matches of a case command
+        -> ([Located (body' GhcTc)],            -- remaining leaf expressions
+            LMatch GhcTc (Located (body' GhcTc))) -- updated match
 replaceLeavesMatch _res_ty leaves (L loc (Match mf pat mt (GRHSs grhss binds)))
   = let
         (leaves', grhss') = mapAccumL replaceLeavesGRHS leaves grhss
@@ -1131,10 +1132,10 @@ replaceLeavesMatch _res_ty leaves (L loc (Match mf pat mt (GRHSs grhss binds)))
     (leaves', L loc (Match mf pat mt (GRHSs grhss' binds)))
 
 replaceLeavesGRHS
-        :: [Located (body' Id)]                 -- replacement leaf expressions of that type
-        -> LGRHS Id (Located (body Id))         -- rhss of a case command
-        -> ([Located (body' Id)],               -- remaining leaf expressions
-            LGRHS Id (Located (body' Id)))      -- updated GRHS
+        :: [Located (body' GhcTc)]  -- replacement leaf expressions of that type
+        -> LGRHS GhcTc (Located (body GhcTc))     -- rhss of a case command
+        -> ([Located (body' GhcTc)],              -- remaining leaf expressions
+            LGRHS GhcTc (Located (body' GhcTc)))  -- updated GRHS
 replaceLeavesGRHS (leaf:leaves) (L loc (GRHS stmts _))
   = (leaves, L loc (GRHS stmts leaf))
 replaceLeavesGRHS [] _ = panic "replaceLeavesGRHS []"
@@ -1172,14 +1173,14 @@ See comments in HsUtils for why the other version does not include
 these bindings.
 -}
 
-collectPatBinders :: LPat Id -> [Id]
+collectPatBinders :: LPat GhcTc -> [Id]
 collectPatBinders pat = collectl pat []
 
-collectPatsBinders :: [LPat Id] -> [Id]
+collectPatsBinders :: [LPat GhcTc] -> [Id]
 collectPatsBinders pats = foldr collectl [] pats
 
 ---------------------
-collectl :: LPat Id -> [Id] -> [Id]
+collectl :: LPat GhcTc -> [Id] -> [Id]
 -- See Note [Dictionary binders in ConPatOut]
 collectl (L _ pat) bndrs
   = go pat
@@ -1219,12 +1220,12 @@ add_ev_bndr (EvBind { eb_lhs = b }) bs | isId b    = b:bs
                                        | otherwise = bs
   -- A worry: what about coercion variable binders??
 
-collectLStmtsBinders :: [LStmt Id body] -> [Id]
+collectLStmtsBinders :: [LStmt GhcTc body] -> [Id]
 collectLStmtsBinders = concatMap collectLStmtBinders
 
-collectLStmtBinders :: LStmt Id body -> [Id]
+collectLStmtBinders :: LStmt GhcTc body -> [Id]
 collectLStmtBinders = collectStmtBinders . unLoc
 
-collectStmtBinders :: Stmt Id body -> [Id]
+collectStmtBinders :: Stmt GhcTc body -> [Id]
 collectStmtBinders (RecStmt { recS_later_ids = later_ids }) = later_ids
 collectStmtBinders stmt = HsUtils.collectStmtBinders stmt
index 26aebe9..2a0abca 100644 (file)
@@ -11,6 +11,7 @@ lower levels it is preserved with @let@/@letrec@s).
 -}
 
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE TypeFamilies #-}
 
 module DsBinds ( dsTopLHsBinds, dsLHsBinds, decomposeRuleLhs, dsSpec,
                  dsHsWrapper, dsTcEvBinds, dsTcEvBinds_s, dsEvBinds, dsMkUserRule
@@ -73,7 +74,7 @@ import Control.Monad
 
 -- | Desugar top level binds, strict binds are treated like normal
 -- binds since there is no good time to force before first usage.
-dsTopLHsBinds :: LHsBinds Id -> DsM (OrdList (Id,CoreExpr))
+dsTopLHsBinds :: LHsBinds GhcTc -> DsM (OrdList (Id,CoreExpr))
 dsTopLHsBinds binds
      -- see Note [Strict binds checks]
   | not (isEmptyBag unlifted_binds) || not (isEmptyBag bang_binds)
@@ -102,7 +103,7 @@ dsTopLHsBinds binds
 
 -- | Desugar all other kind of bindings, Ids of strict binds are returned to
 -- later be forced in the binding group body, see Note [Desugar Strict binds]
-dsLHsBinds :: LHsBinds Id -> DsM ([Id], [(Id,CoreExpr)])
+dsLHsBinds :: LHsBinds GhcTc -> DsM ([Id], [(Id,CoreExpr)])
 dsLHsBinds binds
   = do { MASSERT( allBag (not . isUnliftedHsBind . unLoc) binds )
        ; ds_bs <- mapBagM dsLHsBind binds
@@ -110,14 +111,14 @@ dsLHsBinds binds
                          id ([], []) ds_bs) }
 
 ------------------------
-dsLHsBind :: LHsBind Id
+dsLHsBind :: LHsBind GhcTc
           -> DsM ([Id], [(Id,CoreExpr)])
 dsLHsBind (L loc bind) = do dflags <- getDynFlags
                             putSrcSpanDs loc $ dsHsBind dflags bind
 
 -- | Desugar a single binding (or group of recursive binds).
 dsHsBind :: DynFlags
-         -> HsBind Id
+         -> HsBind GhcTc
          -> DsM ([Id], [(Id,CoreExpr)])
          -- ^ The Ids of strict binds, to be forced in the body of the
          -- binding group see Note [Desugar Strict binds] and all
@@ -275,7 +276,7 @@ dsHsBind dflags
                  ,(poly_tup_id, poly_tup_rhs) :
                    concat export_binds_s) }
   where
-    inline_env :: IdEnv Id   -- Maps a monomorphic local Id to one with
+    inline_env :: IdEnv Id -- Maps a monomorphic local Id to one with
                              -- the inline pragma from the source
                              -- The type checker put the inline pragma
                              -- on the *global* Id, so we need to transfer it
@@ -302,7 +303,7 @@ dsHsBind dflags
             [] lcls
 
     -- find exports or make up new exports for force variables
-    get_exports :: [Id] -> DsM ([Id], [ABExport Id])
+    get_exports :: [Id] -> DsM ([Id], [ABExport GhcTc])
     get_exports lcls =
       foldM (\(glbls, exports) lcl ->
               case lookupVarEnv global_env lcl of
@@ -373,7 +374,8 @@ dsHsBind _ (PatSynBind{}) = panic "dsHsBind: PatSynBind"
 -- the unfolding in the interface file is made in `TidyPgm.addExternal`
 -- using this information.
 ------------------------
-makeCorePair :: DynFlags -> Id -> Bool -> Arity -> CoreExpr -> (Id, CoreExpr)
+makeCorePair :: DynFlags -> Id -> Bool -> Arity -> CoreExpr
+             -> (Id, CoreExpr)
 makeCorePair dflags gbl_id is_default_method dict_arity rhs
   | is_default_method                 -- Default methods are *always* inlined
   = (gbl_id `setIdUnfolding` mkCompulsoryUnfolding rhs, rhs)
index cfd9996..c3d9489 100644 (file)
@@ -7,6 +7,7 @@ Desugaring exporessions.
 -}
 
 {-# LANGUAGE CPP, MultiWayIf #-}
+{-# LANGUAGE TypeFamilies #-}
 
 module DsExpr ( dsExpr, dsLExpr, dsLExprNoLP, dsLocalBinds
               , dsValBinds, dsLit, dsSyntaxExpr ) where
@@ -66,7 +67,7 @@ import Control.Monad
 ************************************************************************
 -}
 
-dsLocalBinds :: LHsLocalBinds Id -> CoreExpr -> DsM CoreExpr
+dsLocalBinds :: LHsLocalBinds GhcTc -> CoreExpr -> DsM CoreExpr
 dsLocalBinds (L _   EmptyLocalBinds)    body = return body
 dsLocalBinds (L loc (HsValBinds binds)) body = putSrcSpanDs loc $
                                                dsValBinds binds body
@@ -74,12 +75,12 @@ dsLocalBinds (L _ (HsIPBinds binds))    body = dsIPBinds  binds body
 
 -------------------------
 -- caller sets location
-dsValBinds :: HsValBinds Id -> CoreExpr -> DsM CoreExpr
+dsValBinds :: HsValBinds GhcTc -> CoreExpr -> DsM CoreExpr
 dsValBinds (ValBindsOut binds _) body = foldrM ds_val_bind body binds
 dsValBinds (ValBindsIn {})       _    = panic "dsValBinds ValBindsIn"
 
 -------------------------
-dsIPBinds :: HsIPBinds Id -> CoreExpr -> DsM CoreExpr
+dsIPBinds :: HsIPBinds GhcTc -> CoreExpr -> DsM CoreExpr
 dsIPBinds (IPBinds ip_binds ev_binds) body
   = do  { ds_binds <- dsTcEvBinds ev_binds
         ; let inner = mkCoreLets ds_binds body
@@ -93,7 +94,7 @@ dsIPBinds (IPBinds ip_binds ev_binds) body
 
 -------------------------
 -- caller sets location
-ds_val_bind :: (RecFlag, LHsBinds Id) -> CoreExpr -> DsM CoreExpr
+ds_val_bind :: (RecFlag, LHsBinds GhcTc) -> CoreExpr -> DsM CoreExpr
 -- Special case for bindings which bind unlifted variables
 -- We need to do a case right away, rather than building
 -- a tuple and doing selections.
@@ -173,7 +174,7 @@ ds_val_bind (is_rec, binds) body
         --    only have to deal with lifted ones now; so Rec is ok
 
 ------------------
-dsUnliftedBind :: HsBind Id -> CoreExpr -> DsM CoreExpr
+dsUnliftedBind :: HsBind GhcTc -> CoreExpr -> DsM CoreExpr
 dsUnliftedBind (AbsBinds { abs_tvs = [], abs_ev_vars = []
                , abs_exports = exports
                , abs_ev_binds = ev_binds
@@ -228,7 +229,7 @@ dsUnliftedBind bind body = pprPanic "dsLet: unlifted" (ppr bind $$ ppr body)
 ************************************************************************
 -}
 
-dsLExpr :: LHsExpr Id -> DsM CoreExpr
+dsLExpr :: LHsExpr GhcTc -> DsM CoreExpr
 
 dsLExpr (L loc e)
   = putSrcSpanDs loc $
@@ -244,19 +245,19 @@ dsLExpr (L loc e)
 -- be an argument to some other function.
 -- See Note [Levity polymorphism checking] in DsMonad
 -- See Note [Levity polymorphism invariants] in CoreSyn
-dsLExprNoLP :: LHsExpr Id -> DsM CoreExpr
+dsLExprNoLP :: LHsExpr GhcTc -> DsM CoreExpr
 dsLExprNoLP (L loc e)
   = putSrcSpanDs loc $
     do { e' <- dsExpr e
        ; dsNoLevPolyExpr e' (text "In the type of expression:" <+> ppr e)
        ; return e' }
 
-dsExpr :: HsExpr Id -> DsM CoreExpr
+dsExpr :: HsExpr GhcTc -> DsM CoreExpr
 dsExpr = ds_expr False
 
 ds_expr :: Bool   -- are we directly inside an HsWrap?
                   -- See Wrinkle in Note [Detecting forced eta expansion]
-        -> HsExpr Id -> DsM CoreExpr
+        -> HsExpr GhcTc -> DsM CoreExpr
 ds_expr _ (HsPar e)              = dsLExpr e
 ds_expr _ (ExprWithTySigOut e _) = dsLExpr e
 ds_expr w (HsVar (L _ var))      = dsHsVar w var
@@ -264,7 +265,7 @@ ds_expr _ (HsUnboundVar {})      = panic "dsExpr: HsUnboundVar" -- Typechecker e
 ds_expr w (HsConLikeOut con)     = dsConLike w con
 ds_expr _ (HsIPVar _)            = panic "dsExpr: HsIPVar"
 ds_expr _ (HsOverLabel{})        = panic "dsExpr: HsOverLabel"
-ds_expr _ (HsLit lit)            = dsLit lit
+ds_expr _ (HsLit lit)            = dsLit (convertLit lit)
 ds_expr _ (HsOverLit lit)        = dsOverLit lit
 
 ds_expr _ (HsWrap co_fn e)
@@ -632,7 +633,7 @@ ds_expr _ expr@(RecordUpd { rupd_expr = record_expr, rupd_flds = fields
         ; return (add_field_binds field_binds' $
                   bindNonRec discrim_var record_expr' matching_code) }
   where
-    ds_field :: LHsRecUpdField Id -> DsM (Name, Id, CoreExpr)
+    ds_field :: LHsRecUpdField GhcTc -> DsM (Name, Id, CoreExpr)
       -- Clone the Id in the HsRecField, because its Name is that
       -- of the record selector, and we must not make that a local binder
       -- else we shadow other uses of the record selector
@@ -768,7 +769,7 @@ ds_expr _ (HsDo          {})  = panic "dsExpr:HsDo"
 ds_expr _ (HsRecFld      {})  = panic "dsExpr:HsRecFld"
 
 ------------------------------
-dsSyntaxExpr :: SyntaxExpr Id -> [CoreExpr] -> DsM CoreExpr
+dsSyntaxExpr :: SyntaxExpr GhcTc -> [CoreExpr] -> DsM CoreExpr
 dsSyntaxExpr (SyntaxExpr { syn_expr      = expr
                          , syn_arg_wraps = arg_wraps
                          , syn_res_wrap  = res_wrap })
@@ -782,7 +783,7 @@ dsSyntaxExpr (SyntaxExpr { syn_expr      = expr
   where
     mk_doc n = text "In the" <+> speakNth n <+> text "argument of" <+> quotes (ppr expr)
 
-findField :: [LHsRecField Id arg] -> Name -> [arg]
+findField :: [LHsRecField GhcTc arg] -> Name -> [arg]
 findField rbinds sel
   = [hsRecFieldArg fld | L _ fld <- rbinds
                        , sel == idName (unLoc $ hsRecFieldId fld) ]
@@ -847,7 +848,7 @@ time.
 maxBuildLength :: Int
 maxBuildLength = 32
 
-dsExplicitList :: Type -> Maybe (SyntaxExpr Id) -> [LHsExpr Id]
+dsExplicitList :: Type -> Maybe (SyntaxExpr GhcTc) -> [LHsExpr GhcTc]
                -> DsM CoreExpr
 -- See Note [Desugaring explicit lists]
 dsExplicitList elt_ty Nothing xs
@@ -871,7 +872,7 @@ dsExplicitList elt_ty (Just fln) xs
        ; dflags <- getDynFlags
        ; dsSyntaxExpr fln [mkIntExprInt dflags (length xs), list] }
 
-dsArithSeq :: PostTcExpr -> (ArithSeqInfo Id) -> DsM CoreExpr
+dsArithSeq :: PostTcExpr -> (ArithSeqInfo GhcTc) -> DsM CoreExpr
 dsArithSeq expr (From from)
   = App <$> dsExpr expr <*> dsLExprNoLP from
 dsArithSeq expr (FromTo from to)
@@ -898,7 +899,7 @@ handled in DsListComp).  Basically does the translation given in the
 Haskell 98 report:
 -}
 
-dsDo :: [ExprLStmt Id] -> DsM CoreExpr
+dsDo :: [ExprLStmt GhcTc] -> DsM CoreExpr
 dsDo stmts
   = goL stmts
   where
@@ -994,7 +995,7 @@ dsDo stmts
     go _ (ParStmt   {}) _ = panic "dsDo ParStmt"
     go _ (TransStmt {}) _ = panic "dsDo TransStmt"
 
-handle_failure :: LPat Id -> MatchResult -> SyntaxExpr Id -> DsM CoreExpr
+handle_failure :: LPat GhcTc -> MatchResult -> SyntaxExpr GhcTc -> DsM CoreExpr
     -- In a do expression, pattern-match failure just calls
     -- the monadic 'fail' rather than throwing an exception
 handle_failure pat match fail_op
@@ -1052,7 +1053,7 @@ dsConLike _ (PatSynCon ps)   = return $ case patSynBuilder ps of
 -}
 
 -- Warn about certain types of values discarded in monadic bindings (#3263)
-warnDiscardedDoBindings :: LHsExpr Id -> Type -> DsM ()
+warnDiscardedDoBindings :: LHsExpr GhcTc -> Type -> DsM ()
 warnDiscardedDoBindings rhs rhs_ty
   | Just (m_ty, elt_ty) <- tcSplitAppTy_maybe rhs_ty
   = do { warn_unused <- woptM Opt_WarnUnusedDoBind
@@ -1080,7 +1081,7 @@ warnDiscardedDoBindings rhs rhs_ty
   | otherwise   -- RHS does have type of form (m ty), which is weird
   = return ()   -- but at lesat this warning is irrelevant
 
-badMonadBind :: LHsExpr Id -> Type -> SDoc
+badMonadBind :: LHsExpr GhcTc -> Type -> SDoc
 badMonadBind rhs elt_ty
   = vcat [ hang (text "A do-notation statement discarded a result of type")
               2 (quotes (ppr elt_ty))
@@ -1143,7 +1144,7 @@ we're not directly in an HsWrap, reject.
 -- | Takes an expression and its instantiated type. If the expression is an
 -- HsVar with a hasNoBinding primop and the type has levity-polymorphic arguments,
 -- issue an error. See Note [Detecting forced eta expansion]
-checkForcedEtaExpansion :: HsExpr Id -> Type -> DsM ()
+checkForcedEtaExpansion :: HsExpr GhcTc -> Type -> DsM ()
 checkForcedEtaExpansion expr ty
   | Just var <- case expr of
                   HsVar (L _ var)               -> Just var
index 864df83..65c4f18 100644 (file)
@@ -1,10 +1,10 @@
 module DsExpr where
-import HsSyn    ( HsExpr, LHsExpr, LHsLocalBinds, SyntaxExpr )
-import Var      ( Id )
-import DsMonad  ( DsM )
-import CoreSyn  ( CoreExpr )
+import HsSyn       ( HsExpr, LHsExpr, LHsLocalBinds, SyntaxExpr )
+import DsMonad     ( DsM )
+import CoreSyn     ( CoreExpr )
+import HsExtension ( GhcTc)
 
-dsExpr  :: HsExpr  Id -> DsM CoreExpr
-dsLExpr, dsLExprNoLP :: LHsExpr Id -> DsM CoreExpr
-dsSyntaxExpr :: SyntaxExpr Id -> [CoreExpr] -> DsM CoreExpr
-dsLocalBinds :: LHsLocalBinds Id -> CoreExpr -> DsM CoreExpr
+dsExpr  :: HsExpr GhcTc -> DsM CoreExpr
+dsLExpr, dsLExprNoLP :: LHsExpr GhcTc -> DsM CoreExpr
+dsSyntaxExpr :: SyntaxExpr GhcTc -> [CoreExpr] -> DsM CoreExpr
+dsLocalBinds :: LHsLocalBinds GhcTc -> CoreExpr -> DsM CoreExpr
index 9998a4d..fb3752d 100644 (file)
@@ -7,6 +7,8 @@ Desugaring foreign declarations (see also DsCCall).
 -}
 
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE TypeFamilies #-}
 
 module DsForeign ( dsForeigns ) where
 
@@ -69,14 +71,14 @@ is the same as
 so we reuse the desugaring code in @DsCCall@ to deal with these.
 -}
 
-type Binding = (Id, CoreExpr)   -- No rec/nonrec structure;
-                                -- the occurrence analyser will sort it all out
+type Binding = (Id, CoreExpr) -- No rec/nonrec structure;
+                              -- the occurrence analyser will sort it all out
 
-dsForeigns :: [LForeignDecl Id]
+dsForeigns :: [LForeignDecl GhcTc]
            -> DsM (ForeignStubs, OrdList Binding)
 dsForeigns fos = getHooked dsForeignsHook dsForeigns' >>= ($ fos)
 
-dsForeigns' :: [LForeignDecl Id]
+dsForeigns' :: [LForeignDecl GhcTc]
             -> DsM (ForeignStubs, OrdList Binding)
 dsForeigns' []
   = return (NoStubs, nilOL)
index e664612..c3dcdf6 100644 (file)
@@ -18,7 +18,6 @@ import {-# SOURCE #-} Match   ( matchSinglePat )
 import HsSyn
 import MkCore
 import CoreSyn
-import Var
 
 import DsMonad
 import DsUtils
@@ -44,7 +43,7 @@ producing an expression with a runtime error in the corner if
 necessary.  The type argument gives the type of the @ei@.
 -}
 
-dsGuarded :: GRHSs Id (LHsExpr Id) -> Type -> DsM CoreExpr
+dsGuarded :: GRHSs GhcTc (LHsExpr GhcTc) -> Type -> DsM CoreExpr
 
 dsGuarded grhss rhs_ty = do
     match_result <- dsGRHSs PatBindRhs grhss rhs_ty
@@ -54,7 +53,7 @@ dsGuarded grhss rhs_ty = do
 -- In contrast, @dsGRHSs@ produces a @MatchResult@.
 
 dsGRHSs :: HsMatchContext Name
-        -> GRHSs Id (LHsExpr Id)                -- Guarded RHSs
+        -> GRHSs GhcTc (LHsExpr GhcTc)          -- Guarded RHSs
         -> Type                                 -- Type of RHS
         -> DsM MatchResult
 dsGRHSs hs_ctx (GRHSs grhss binds) rhs_ty
@@ -65,7 +64,8 @@ dsGRHSs hs_ctx (GRHSs grhss binds) rhs_ty
                              -- NB: nested dsLet inside matchResult
        ; return match_result2 }
 
-dsGRHS :: HsMatchContext Name -> Type -> LGRHS Id (LHsExpr Id) -> DsM MatchResult
+dsGRHS :: HsMatchContext Name -> Type -> LGRHS GhcTc (LHsExpr GhcTc)
+       -> DsM MatchResult
 dsGRHS hs_ctx rhs_ty (L _ (GRHS guards rhs))
   = matchGuards (map unLoc guards) (PatGuard hs_ctx) rhs rhs_ty
 
@@ -77,10 +77,10 @@ dsGRHS hs_ctx rhs_ty (L _ (GRHS guards rhs))
 ************************************************************************
 -}
 
-matchGuards :: [GuardStmt Id]       -- Guard
-            -> HsStmtContext Name   -- Context
-            -> LHsExpr Id           -- RHS
-            -> Type                 -- Type of RHS of guard
+matchGuards :: [GuardStmt GhcTc]     -- Guard
+            -> HsStmtContext Name    -- Context
+            -> LHsExpr GhcTc         -- RHS
+            -> Type                  -- Type of RHS of guard
             -> DsM MatchResult
 
 -- See comments with HsExpr.Stmt re what a BodyStmt means
@@ -126,7 +126,7 @@ matchGuards (RecStmt   {} : _) _ _ _ = panic "matchGuards RecStmt"
 matchGuards (ApplicativeStmt {} : _) _ _ _ =
   panic "matchGuards ApplicativeLastStmt"
 
-isTrueLHsExpr :: LHsExpr Id -> Maybe (CoreExpr -> DsM CoreExpr)
+isTrueLHsExpr :: LHsExpr GhcTc -> Maybe (CoreExpr -> DsM CoreExpr)
 
 -- Returns Just {..} if we're sure that the expression is True
 -- I.e.   * 'True' datacon
index 2bb303e..dc24183 100644 (file)
@@ -7,6 +7,7 @@ Desugaring list comprehensions, monad comprehensions and array comprehensions
 -}
 
 {-# LANGUAGE CPP, NamedFieldPuns #-}
+{-# LANGUAGE TypeFamilies #-}
 
 module DsListComp ( dsListComp, dsPArrComp, dsMonadComp ) where
 
@@ -43,7 +44,7 @@ turned on'' (if you read Gill {\em et al.}'s paper on the subject).
 There will be at least one ``qualifier'' in the input.
 -}
 
-dsListComp :: [ExprLStmt Id]
+dsListComp :: [ExprLStmt GhcTc]
            -> Type              -- Type of entire list
            -> DsM CoreExpr
 dsListComp lquals res_ty = do
@@ -78,7 +79,7 @@ dsListComp lquals res_ty = do
 -- This function lets you desugar a inner list comprehension and a list of the binders
 -- of that comprehension that we need in the outer comprehension into such an expression
 -- and the type of the elements that it outputs (tuples of binders)
-dsInnerListComp :: (ParStmtBlock Id Id) -> DsM (CoreExpr, Type)
+dsInnerListComp :: (ParStmtBlock GhcTc GhcTc) -> DsM (CoreExpr, Type)
 dsInnerListComp (ParStmtBlock stmts bndrs _)
   = do { let bndrs_tuple_type = mkBigCoreVarTupTy bndrs
              list_ty          = mkListTy bndrs_tuple_type
@@ -91,7 +92,7 @@ dsInnerListComp (ParStmtBlock stmts bndrs _)
 -- This function factors out commonality between the desugaring strategies for GroupStmt.
 -- Given such a statement it gives you back an expression representing how to compute the transformed
 -- list and the tuple that you need to bind from that list in order to proceed with your desugaring
-dsTransStmt :: ExprStmt Id -> DsM (CoreExpr, LPat Id)
+dsTransStmt :: ExprStmt GhcTc -> DsM (CoreExpr, LPat GhcTc)
 dsTransStmt (TransStmt { trS_form = form, trS_stmts = stmts, trS_bndrs = binderMap
                        , trS_by = by, trS_using = using }) = do
     let (from_bndrs, to_bndrs) = unzip binderMap
@@ -211,7 +212,7 @@ The introduced tuples are Boxed, but only because I couldn't get it to work
 with the Unboxed variety.
 -}
 
-deListComp :: [ExprStmt Id] -> CoreExpr -> DsM CoreExpr
+deListComp :: [ExprStmt GhcTc] -> CoreExpr -> DsM CoreExpr
 
 deListComp [] _ = panic "deListComp"
 
@@ -261,9 +262,9 @@ deListComp (RecStmt {} : _) _ = panic "deListComp RecStmt"
 deListComp (ApplicativeStmt {} : _) _ =
   panic "deListComp ApplicativeStmt"
 
-deBindComp :: OutPat Id
+deBindComp :: OutPat GhcTc
            -> CoreExpr
-           -> [ExprStmt Id]
+           -> [ExprStmt GhcTc]
            -> CoreExpr
            -> DsM (Expr Id)
 deBindComp pat core_list1 quals core_list2 = do
@@ -317,8 +318,8 @@ TE[ e | p <- l , q ] c n = let
 \end{verbatim}
 -}
 
-dfListComp :: Id -> Id         -- 'c' and 'n'
-           -> [ExprStmt Id]    -- the rest of the qual's
+dfListComp :: Id -> Id            -- 'c' and 'n'
+           -> [ExprStmt GhcTc]    -- the rest of the qual's
            -> DsM CoreExpr
 
 dfListComp _ _ [] = panic "dfListComp"
@@ -356,9 +357,9 @@ dfListComp _ _ (RecStmt {} : _) = panic "dfListComp RecStmt"
 dfListComp _ _ (ApplicativeStmt {} : _) =
   panic "dfListComp ApplicativeStmt"
 
-dfBindComp :: Id -> Id          -- 'c' and 'n'
-           -> (LPat Id, CoreExpr)
-           -> [ExprStmt Id]     -- the rest of the qual's
+dfBindComp :: Id -> Id             -- 'c' and 'n'
+           -> (LPat GhcTc, CoreExpr)
+           -> [ExprStmt GhcTc]     -- the rest of the qual's
            -> DsM CoreExpr
 dfBindComp c_id n_id (pat, core_list1) quals = do
     -- find the required type
@@ -478,7 +479,7 @@ mkUnzipBind _ elt_tys
 --
 --   [:e | qss:] = <<[:e | qss:]>> () [:():]
 --
-dsPArrComp :: [ExprStmt Id]
+dsPArrComp :: [ExprStmt GhcTc]
             -> DsM CoreExpr
 
 -- Special case for parallel comprehension
@@ -514,8 +515,8 @@ dsPArrComp qs = do -- no ParStmt in `qs'
 
 -- the work horse
 --
-dePArrComp :: [ExprStmt Id]
-           -> LPat Id           -- the current generator pattern
+dePArrComp :: [ExprStmt GhcTc]
+           -> LPat GhcTc        -- the current generator pattern
            -> CoreExpr          -- the current generator expression
            -> DsM CoreExpr
 
@@ -612,7 +613,7 @@ dePArrComp (ApplicativeStmt   {} : _) _ _ =
 --    where
 --      {x_1, ..., x_n} = DV (qs)
 --
-dePArrParComp :: [ParStmtBlock Id Id] -> [ExprStmt Id] -> DsM CoreExpr
+dePArrParComp :: [ParStmtBlock GhcTc GhcTc] -> [ExprStmt GhcTc] -> DsM CoreExpr
 dePArrParComp qss quals = do
     (pQss, ceQss) <- deParStmt qss
     dePArrComp quals pQss ceQss
@@ -639,8 +640,8 @@ dePArrParComp qss quals = do
 -- generate Core corresponding to `\p -> e'
 --
 deLambda :: Type                       -- type of the argument (not levity-polymorphic)
-         -> LPat Id                    -- argument pattern
-         -> LHsExpr Id                 -- body
+         -> LPat GhcTc                 -- argument pattern
+         -> LHsExpr GhcTc              -- body
          -> DsM (CoreExpr, Type)
 deLambda ty p e =
     mkLambda ty p =<< dsLExpr e
@@ -648,7 +649,7 @@ deLambda ty p e =
 -- generate Core for a lambda pattern match, where the body is already in Core
 --
 mkLambda :: Type                        -- type of the argument (not levity-polymorphic)
-         -> LPat Id                     -- argument pattern
+         -> LPat GhcTc                  -- argument pattern
          -> CoreExpr                    -- desugared body
          -> DsM (CoreExpr, Type)
 mkLambda ty p ce = do
@@ -672,15 +673,15 @@ parrElemType e  =
 -- Translation for monad comprehensions
 
 -- Entry point for monad comprehension desugaring
-dsMonadComp :: [ExprLStmt Id] -> DsM CoreExpr
+dsMonadComp :: [ExprLStmt GhcTc] -> DsM CoreExpr
 dsMonadComp stmts = dsMcStmts stmts
 
-dsMcStmts :: [ExprLStmt Id] -> DsM CoreExpr
+dsMcStmts :: [ExprLStmt GhcTc] -> DsM CoreExpr
 dsMcStmts []                    = panic "dsMcStmts"
 dsMcStmts (L loc stmt : lstmts) = putSrcSpanDs loc (dsMcStmt stmt lstmts)
 
 ---------------
-dsMcStmt :: ExprStmt Id -> [ExprLStmt Id] -> DsM CoreExpr
+dsMcStmt :: ExprStmt GhcTc -> [ExprLStmt GhcTc] -> DsM CoreExpr
 
 dsMcStmt (LastStmt body _ ret_op) stmts
   = ASSERT( null stmts )
@@ -803,12 +804,12 @@ matchTuple ids body
 
 -- general `rhs' >>= \pat -> stmts` desugaring where `rhs'` is already a
 -- desugared `CoreExpr`
-dsMcBindStmt :: LPat Id
+dsMcBindStmt :: LPat GhcTc
              -> CoreExpr        -- ^ the desugared rhs of the bind statement
-             -> SyntaxExpr Id
-             -> SyntaxExpr Id
+             -> SyntaxExpr GhcTc
+             -> SyntaxExpr GhcTc
              -> Type            -- ^ S in (>>=) :: Q -> (R -> S) -> T
-             -> [ExprLStmt Id]
+             -> [ExprLStmt GhcTc]
              -> DsM CoreExpr
 dsMcBindStmt pat rhs' bind_op fail_op res1_ty stmts
   = do  { body     <- dsMcStmts stmts
@@ -840,9 +841,9 @@ dsMcBindStmt pat rhs' bind_op fail_op res1_ty stmts
 -- returns the desugaring of
 --       [ (a,b,c) | quals ]
 
-dsInnerMonadComp :: [ExprLStmt Id]
-                 -> [Id]            -- Return a tuple of these variables
-                 -> SyntaxExpr Id   -- The monomorphic "return" operator
+dsInnerMonadComp :: [ExprLStmt GhcTc]
+                 -> [Id]               -- Return a tuple of these variables
+                 -> SyntaxExpr GhcTc   -- The monomorphic "return" operator
                  -> DsM CoreExpr
 dsInnerMonadComp stmts bndrs ret_op
   = dsMcStmts (stmts ++ [noLoc (LastStmt (mkBigLHsVarTupId bndrs) False ret_op)])
@@ -860,7 +861,7 @@ dsInnerMonadComp stmts bndrs ret_op
 --       , fmap (selN2 :: (t1, t2) -> t2) ys )
 
 mkMcUnzipM :: TransForm
-           -> HsExpr TcId       -- fmap
+           -> HsExpr GhcTcId    -- fmap
            -> Id                -- Of type n (a,b,c)
            -> [Type]            -- [a,b,c]   (not levity-polymorphic)
            -> DsM CoreExpr      -- Of type (n a, n b, n c)
index bb4361e..f7f2fd5 100644 (file)
@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP, TypeFamilies #-}
+{-# LANGUAGE FlexibleContexts #-}
 
 -----------------------------------------------------------------------------
 --
@@ -64,7 +65,7 @@ import Control.Monad
 import Data.List
 
 -----------------------------------------------------------------------------
-dsBracket :: HsBracket Name -> [PendingTcSplice] -> DsM CoreExpr
+dsBracket :: HsBracket GhcRn -> [PendingTcSplice] -> DsM CoreExpr
 -- Returns a CoreExpr of type TH.ExpQ
 -- The quoted thing is parameterised over Name, even though it has
 -- been type checked.  We don't want all those type decorations!
@@ -101,12 +102,12 @@ dsBracket brack splices
 --                      Declarations
 -------------------------------------------------------
 
-repTopP :: LPat Name -> DsM (Core TH.PatQ)
+repTopP :: LPat GhcRn -> DsM (Core TH.PatQ)
 repTopP pat = do { ss <- mkGenSyms (collectPatBinders pat)
                  ; pat' <- addBinds ss (repLP pat)
                  ; wrapGenSyms ss pat' }
 
-repTopDs :: HsGroup Name -> DsM (Core (TH.Q [TH.Dec]))
+repTopDs :: HsGroup GhcRn -> DsM (Core (TH.Q [TH.Dec]))
 repTopDs group@(HsGroup { hs_valds   = valds
                         , hs_splcds  = splcds
                         , hs_tyclds  = tyclds
@@ -178,12 +179,12 @@ repTopDs group@(HsGroup { hs_valds   = valds
     no_doc (L loc _)
       = notHandledL loc "Haddock documentation" empty
 
-hsSigTvBinders :: HsValBinds Name -> [Name]
+hsSigTvBinders :: HsValBinds GhcRn -> [Name]
 -- See Note [Scoped type variables in bindings]
 hsSigTvBinders binds
   = concatMap get_scoped_tvs sigs
   where
-    get_scoped_tvs :: LSig Name -> [Name]
+    get_scoped_tvs :: LSig GhcRn -> [Name]
     -- Both implicit and explicit quantified variables
     -- We need the implicit ones for   f :: forall (a::k). blah
     --    here 'k' scopes too
@@ -262,7 +263,7 @@ them into a `ForallT` or `ForallC`. Doing so caused #13018 and #13123.
 
 -- represent associated family instances
 --
-repTyClD :: LTyClDecl Name -> DsM (Maybe (SrcSpan, Core TH.DecQ))
+repTyClD :: LTyClDecl GhcRn -> DsM (Maybe (SrcSpan, Core TH.DecQ))
 
 repTyClD (L loc (FamDecl { tcdFam = fam })) = liftM Just $ repFamilyDecl (L loc fam)
 
@@ -297,7 +298,7 @@ repTyClD (L loc (ClassDecl { tcdCtxt = cxt, tcdLName = cls,
        }
 
 -------------------------
-repRoleD :: LRoleAnnotDecl Name -> DsM (SrcSpan, Core TH.DecQ)
+repRoleD :: LRoleAnnotDecl GhcRn -> DsM (SrcSpan, Core TH.DecQ)
 repRoleD (L loc (RoleAnnotDecl tycon roles))
   = do { tycon1 <- lookupLOcc tycon
        ; roles1 <- mapM repRole roles
@@ -308,7 +309,7 @@ repRoleD (L loc (RoleAnnotDecl tycon roles))
 -------------------------
 repDataDefn :: Core TH.Name -> Core [TH.TyVarBndr]
             -> Maybe (Core [TH.TypeQ])
-            -> HsDataDefn Name
+            -> HsDataDefn GhcRn
             -> DsM (Core TH.DecQ)
 repDataDefn tc bndrs opt_tys
           (HsDataDefn { dd_ND = new_or_data, dd_ctxt = cxt, dd_kindSig = ksig
@@ -331,20 +332,20 @@ repDataDefn tc bndrs opt_tys
        }
 
 repSynDecl :: Core TH.Name -> Core [TH.TyVarBndr]
-           -> LHsType Name
+           -> LHsType GhcRn
            -> DsM (Core TH.DecQ)
 repSynDecl tc bndrs ty
   = do { ty1 <- repLTy ty
        ; repTySyn tc bndrs ty1 }
 
-repFamilyDecl :: LFamilyDecl Name -> DsM (SrcSpan, Core TH.DecQ)
+repFamilyDecl :: LFamilyDecl GhcRn -> DsM (SrcSpan, Core TH.DecQ)
 repFamilyDecl decl@(L loc (FamilyDecl { fdInfo      = info,
                                         fdLName     = tc,
                                         fdTyVars    = tvs,
                                         fdResultSig = L _ resultSig,
                                         fdInjectivityAnn = injectivity }))
   = do { tc1 <- lookupLOcc tc           -- See note [Binders and occurrences]
-       ; let mkHsQTvs :: [LHsTyVarBndr Name] -> LHsQTyVars Name
+       ; let mkHsQTvs :: [LHsTyVarBndr GhcRn] -> LHsQTyVars GhcRn
              mkHsQTvs tvs = HsQTvs { hsq_implicit = [], hsq_explicit = tvs
                                    , hsq_dependent = emptyNameSet }
              resTyVar = case resultSig of
@@ -372,7 +373,7 @@ repFamilyDecl decl@(L loc (FamilyDecl { fdInfo      = info,
        }
 
 -- | Represent result signature of a type family
-repFamilyResultSig :: FamilyResultSig Name -> DsM (Core TH.FamilyResultSig)
+repFamilyResultSig :: FamilyResultSig GhcRn -> DsM (Core TH.FamilyResultSig)
 repFamilyResultSig  NoSig          = repNoSig
 repFamilyResultSig (KindSig ki)    = do { ki' <- repLKind ki
                                         ; repKindSig ki' }
@@ -382,7 +383,7 @@ repFamilyResultSig (TyVarSig bndr) = do { bndr' <- repTyVarBndr bndr
 -- | Represent result signature using a Maybe Kind. Used with data families,
 -- where the result signature can be either missing or a kind but never a named
 -- result variable.
-repFamilyResultSigToMaybeKind :: FamilyResultSig Name
+repFamilyResultSigToMaybeKind :: FamilyResultSig GhcRn
                               -> DsM (Core (Maybe TH.Kind))
 repFamilyResultSigToMaybeKind NoSig =
     do { coreNothing kindTyConName }
@@ -392,7 +393,7 @@ repFamilyResultSigToMaybeKind (KindSig ki) =
 repFamilyResultSigToMaybeKind _ = panic "repFamilyResultSigToMaybeKind"
 
 -- | Represent injectivity annotation of a type family
-repInjectivityAnn :: Maybe (LInjectivityAnn Name)
+repInjectivityAnn :: Maybe (LInjectivityAnn GhcRn)
                   -> DsM (Core (Maybe TH.InjectivityAnn))
 repInjectivityAnn Nothing =
     do { coreNothing injAnnTyConName }
@@ -403,14 +404,14 @@ repInjectivityAnn (Just (L _ (InjectivityAnn lhs rhs))) =
        ; injAnn <- rep2 injectivityAnnName [unC lhs', unC rhs2]
        ; coreJust injAnnTyConName injAnn }
 
-repFamilyDecls :: [LFamilyDecl Name] -> DsM [Core TH.DecQ]
+repFamilyDecls :: [LFamilyDecl GhcRn] -> DsM [Core TH.DecQ]
 repFamilyDecls fds = liftM de_loc (mapM repFamilyDecl fds)
 
-repAssocTyFamDefaults :: [LTyFamDefltEqn Name] -> DsM [Core TH.DecQ]
+repAssocTyFamDefaults :: [LTyFamDefltEqn GhcRn] -> DsM [Core TH.DecQ]
 repAssocTyFamDefaults = mapM rep_deflt
   where
      -- very like repTyFamEqn, but different in the details
-    rep_deflt :: LTyFamDefltEqn Name -> DsM (Core TH.DecQ)
+    rep_deflt :: LTyFamDefltEqn GhcRn -> DsM (Core TH.DecQ)
     rep_deflt (L _ (TyFamEqn { tfe_tycon = tc
                              , tfe_pats  = bndrs
                              , tfe_rhs   = rhs }))
@@ -436,7 +437,7 @@ repLFunDep (L _ (xs, ys))
 
 -- Represent instance declarations
 --
-repInstD :: LInstDecl Name -> DsM (SrcSpan, Core TH.DecQ)
+repInstD :: LInstDecl GhcRn -> DsM (SrcSpan, Core TH.DecQ)
 repInstD (L loc (TyFamInstD { tfid_inst = fi_decl }))
   = do { dec <- repTyFamInstD fi_decl
        ; return (loc, dec) }
@@ -447,7 +448,7 @@ repInstD (L loc (ClsInstD { cid_inst = cls_decl }))
   = do { dec <- repClsInstD cls_decl
        ; return (loc, dec) }
 
-repClsInstD :: ClsInstDecl Name -> DsM (Core TH.DecQ)
+repClsInstD :: ClsInstDecl GhcRn -> DsM (Core TH.DecQ)
 repClsInstD (ClsInstDecl { cid_poly_ty = ty, cid_binds = binds
                          , cid_sigs = prags, cid_tyfam_insts = ats
                          , cid_datafam_insts = adts
@@ -475,7 +476,7 @@ repClsInstD (ClsInstDecl { cid_poly_ty = ty, cid_binds = binds
  where
    (tvs, cxt, inst_ty) = splitLHsInstDeclTy ty
 
-repStandaloneDerivD :: LDerivDecl Name -> DsM (SrcSpan, Core TH.DecQ)
+repStandaloneDerivD :: LDerivDecl GhcRn -> DsM (SrcSpan, Core TH.DecQ)
 repStandaloneDerivD (L loc (DerivDecl { deriv_strategy = strat
                                       , deriv_type     = ty }))
   = do { dec <- addSimpleTyVarBinds tvs $
@@ -487,14 +488,14 @@ repStandaloneDerivD (L loc (DerivDecl { deriv_strategy = strat
   where
     (tvs, cxt, inst_ty) = splitLHsInstDeclTy ty
 
-repTyFamInstD :: TyFamInstDecl Name -> DsM (Core TH.DecQ)
+repTyFamInstD :: TyFamInstDecl GhcRn -> DsM (Core TH.DecQ)
 repTyFamInstD decl@(TyFamInstDecl { tfid_eqn = eqn })
   = do { let tc_name = tyFamInstDeclLName decl
        ; tc <- lookupLOcc tc_name               -- See note [Binders and occurrences]
        ; eqn1 <- repTyFamEqn eqn
        ; repTySynInst tc eqn1 }
 
-repTyFamEqn :: LTyFamInstEqn Name -> DsM (Core TH.TySynEqnQ)
+repTyFamEqn :: LTyFamInstEqn GhcRn -> DsM (Core TH.TySynEqnQ)
 repTyFamEqn (L _ (TyFamEqn { tfe_pats = HsIB { hsib_body = tys
                                              , hsib_vars = var_names }
                            , tfe_rhs = rhs }))
@@ -507,7 +508,7 @@ repTyFamEqn (L _ (TyFamEqn { tfe_pats = HsIB { hsib_body = tys
             ; rhs1 <- repLTy rhs
             ; repTySynEqn tys2 rhs1 } }
 
-repDataFamInstD :: DataFamInstDecl Name -> DsM (Core TH.DecQ)
+repDataFamInstD :: DataFamInstDecl GhcRn -> DsM (Core TH.DecQ)
 repDataFamInstD (DataFamInstDecl { dfid_tycon = tc_name
                                  , dfid_pats = HsIB { hsib_body = tys, hsib_vars = var_names }
                                  , dfid_defn = defn })
@@ -519,7 +520,7 @@ repDataFamInstD (DataFamInstDecl { dfid_tycon = tc_name
          do { tys1 <- repList typeQTyConName repLTy tys
             ; repDataDefn tc bndrs (Just tys1) defn } }
 
-repForD :: Located (ForeignDecl Name) -> DsM (SrcSpan, Core TH.DecQ)
+repForD :: Located (ForeignDecl GhcRn) -> DsM (SrcSpan, Core TH.DecQ)
 repForD (L loc (ForeignImport { fd_name = name, fd_sig_ty = typ
                               , fd_fi = CImport (L _ cc) (L _ s) mch cis _ }))
  = do MkC name' <- lookupLOcc name
@@ -560,7 +561,7 @@ repSafety PlayRisky = rep2 unsafeName []
 repSafety PlayInterruptible = rep2 interruptibleName []
 repSafety PlaySafe = rep2 safeName []
 
-repFixD :: LFixitySig Name -> DsM [(SrcSpan, Core TH.DecQ)]
+repFixD :: LFixitySig GhcRn -> DsM [(SrcSpan, Core TH.DecQ)]
 repFixD (L loc (FixitySig names (Fixity _ prec dir)))
   = do { MkC prec' <- coreIntLit prec
        ; let rep_fn = case dir of
@@ -573,7 +574,7 @@ repFixD (L loc (FixitySig names (Fixity _ prec dir)))
                    ; return (loc,dec) }
        ; mapM do_one names }
 
-repRuleD :: LRuleDecl Name -> DsM (SrcSpan, Core TH.DecQ)
+repRuleD :: LRuleDecl GhcRn -> DsM (SrcSpan, Core TH.DecQ)
 repRuleD (L loc (HsRule n act bndrs lhs _ rhs _))
   = do { let bndr_names = concatMap ruleBndrNames bndrs
        ; ss <- mkGenSyms bndr_names
@@ -587,13 +588,13 @@ repRuleD (L loc (HsRule n act bndrs lhs _ rhs _))
        ; rule2 <- wrapGenSyms ss rule1
        ; return (loc, rule2) }
 
-ruleBndrNames :: LRuleBndr Name -> [Name]
+ruleBndrNames :: LRuleBndr GhcRn -> [Name]
 ruleBndrNames (L _ (RuleBndr n))      = [unLoc n]
 ruleBndrNames (L _ (RuleBndrSig n sig))
   | HsWC { hswc_body = HsIB { hsib_vars = vars }} <- sig
   = unLoc n : vars
 
-repRuleBndr :: LRuleBndr Name -> DsM (Core TH.RuleBndrQ)
+repRuleBndr :: LRuleBndr GhcRn -> DsM (Core TH.RuleBndrQ)
 repRuleBndr (L _ (RuleBndr n))
   = do { MkC n' <- lookupLBinder n
        ; rep2 ruleVarName [n'] }
@@ -602,7 +603,7 @@ repRuleBndr (L _ (RuleBndrSig n sig))
        ; MkC ty' <- repLTy (hsSigWcType sig)
        ; rep2 typedRuleVarName [n', ty'] }
 
-repAnnD :: LAnnDecl Name -> DsM (SrcSpan, Core TH.DecQ)
+repAnnD :: LAnnDecl GhcRn -> DsM (SrcSpan, Core TH.DecQ)
 repAnnD (L loc (HsAnnotation _ ann_prov (L _ exp)))
   = do { target <- repAnnProv ann_prov
        ; exp'   <- repE exp
@@ -623,7 +624,7 @@ repAnnProv ModuleAnnProvenance
 --                      Constructors
 -------------------------------------------------------
 
-repC :: LConDecl Name -> DsM (Core TH.ConQ)
+repC :: LConDecl GhcRn -> DsM (Core TH.ConQ)
 repC (L _ (ConDeclH98 { con_name = con
                       , con_qvars = Nothing, con_cxt = Nothing
                       , con_details = details }))
@@ -681,7 +682,7 @@ repSrcStrictness SrcLazy     = rep2 sourceLazyName         []
 repSrcStrictness SrcStrict   = rep2 sourceStrictName       []
 repSrcStrictness NoSrcStrict = rep2 noSourceStrictnessName []
 
-repBangTy :: LBangType Name -> DsM (Core (TH.BangTypeQ))
+repBangTy :: LBangType GhcRn -> DsM (Core (TH.BangTypeQ))
 repBangTy ty = do
   MkC u <- repSrcUnpackedness su'
   MkC s <- repSrcStrictness ss'
@@ -697,10 +698,10 @@ repBangTy ty = do
 --                      Deriving clauses
 -------------------------------------------------------
 
-repDerivs :: HsDeriving Name -> DsM (Core [TH.DerivClauseQ])
+repDerivs :: HsDeriving GhcRn -> DsM (Core [TH.DerivClauseQ])
 repDerivs (L _ clauses) = repList derivClauseQTyConName repDerivClause clauses
 
-repDerivClause :: LHsDerivingClause Name
+repDerivClause :: LHsDerivingClause GhcRn
                -> DsM (Core TH.DerivClauseQ)
 repDerivClause (L _ (HsDerivingClause { deriv_clause_strategy = dcs
                                       , deriv_clause_tys      = L _ dct }))
@@ -708,22 +709,22 @@ repDerivClause (L _ (HsDerivingClause { deriv_clause_strategy = dcs
        MkC dct' <- repList typeQTyConName (rep_deriv_ty . hsSigType) dct
        rep2 derivClauseName [dcs',dct']
   where
-    rep_deriv_ty :: LHsType Name -> DsM (Core TH.TypeQ)
+    rep_deriv_ty :: LHsType GhcRn -> DsM (Core TH.TypeQ)
     rep_deriv_ty (L _ ty) = repTy ty
 
 -------------------------------------------------------
 --   Signatures in a class decl, or a group of bindings
 -------------------------------------------------------
 
-rep_sigs :: [LSig Name] -> DsM [Core TH.DecQ]
+rep_sigs :: [LSig GhcRn] -> DsM [Core TH.DecQ]
 rep_sigs sigs = do locs_cores <- rep_sigs' sigs
                    return $ de_loc $ sort_by_loc locs_cores
 
-rep_sigs' :: [LSig Name] -> DsM [(SrcSpan, Core TH.DecQ)]
+rep_sigs' :: [LSig GhcRn] -> DsM [(SrcSpan, Core TH.DecQ)]
         -- We silently ignore ones we don't recognise
 rep_sigs' = concatMapM rep_sig
 
-rep_sig :: LSig Name -> DsM [(SrcSpan, Core TH.DecQ)]
+rep_sig :: LSig GhcRn -> DsM [(SrcSpan, Core TH.DecQ)]
 rep_sig (L loc (TypeSig nms ty))      = mapM (rep_wc_ty_sig sigDName loc ty) nms
 rep_sig (L loc (PatSynSig nms ty))    = mapM (rep_patsyn_ty_sig loc ty) nms
 rep_sig (L loc (ClassOpSig is_deflt nms ty))
@@ -740,7 +741,7 @@ rep_sig (L _   (SCCFunSig {}))        = notHandled "SCC pragmas" empty
 rep_sig (L loc (CompleteMatchSig _st cls mty)) = rep_complete_sig cls mty loc
 
 
-rep_ty_sig :: Name -> SrcSpan -> LHsSigType Name -> Located Name
+rep_ty_sig :: Name -> SrcSpan -> LHsSigType GhcRn -> Located Name
            -> DsM (SrcSpan, Core TH.DecQ)
 rep_ty_sig mk_sig loc sig_ty nm
   = do { nm1 <- lookupLOcc nm
@@ -748,7 +749,7 @@ rep_ty_sig mk_sig loc sig_ty nm
        ; sig <- repProto mk_sig nm1 ty1
        ; return (loc, sig) }
 
-rep_patsyn_ty_sig :: SrcSpan -> LHsSigType Name -> Located Name
+rep_patsyn_ty_sig :: SrcSpan -> LHsSigType GhcRn -> Located Name
                   -> DsM (SrcSpan, Core TH.DecQ)
 -- represents a pattern synonym type signature;
 -- see Note [Pattern synonym type signatures and Template Haskell] in Convert
@@ -758,7 +759,7 @@ rep_patsyn_ty_sig loc sig_ty nm
        ; sig <- repProto patSynSigDName nm1 ty1
        ; return (loc, sig) }
 
-rep_wc_ty_sig :: Name -> SrcSpan -> LHsSigWcType Name -> Located Name
+rep_wc_ty_sig :: Name -> SrcSpan -> LHsSigWcType GhcRn -> Located Name
               -> DsM (SrcSpan, Core TH.DecQ)
     -- We must special-case the top-level explicit for-all of a TypeSig
     -- See Note [Scoped type variables in bindings]
@@ -794,7 +795,8 @@ rep_inline nm ispec loc
        ; return [(loc, pragma)]
        }
 
-rep_specialise :: Located Name -> LHsSigType Name -> InlinePragma -> SrcSpan
+rep_specialise :: Located Name -> LHsSigType GhcRn -> InlinePragma
+               -> SrcSpan
                -> DsM [(SrcSpan, Core TH.DecQ)]
 rep_specialise nm ty ispec loc
   = do { nm1 <- lookupLOcc nm
@@ -810,7 +812,8 @@ rep_specialise nm ty ispec loc
        ; return [(loc, pragma)]
        }
 
-rep_specialiseInst :: LHsSigType Name -> SrcSpan -> DsM [(SrcSpan, Core TH.DecQ)]
+rep_specialiseInst :: LHsSigType GhcRn -> SrcSpan
+                   -> DsM [(SrcSpan, Core TH.DecQ)]
 rep_specialiseInst ty loc
   = do { ty1    <- repHsSigType ty
        ; pragma <- repPragSpecInst ty1
@@ -860,7 +863,7 @@ addSimpleTyVarBinds names thing_inside
        ; term <- addBinds fresh_names thing_inside
        ; wrapGenSyms fresh_names term }
 
-addTyVarBinds :: LHsQTyVars Name                            -- the binders to be added
+addTyVarBinds :: LHsQTyVars GhcRn                    -- the binders to be added
               -> (Core [TH.TyVarBndr] -> DsM (Core (TH.Q a)))  -- action in the ext env
               -> DsM (Core (TH.Q a))
 -- gensym a list of type variables and enter them into the meta environment;
@@ -879,7 +882,7 @@ addTyVarBinds (HsQTvs { hsq_implicit = imp_tvs, hsq_explicit = exp_tvs }) m
   where
     mk_tv_bndr (tv, (_,v)) = repTyVarBndrWithKind tv (coreVar v)
 
-addTyClTyVarBinds :: LHsQTyVars Name
+addTyClTyVarBinds :: LHsQTyVars GhcRn
                   -> (Core [TH.TyVarBndr] -> DsM (Core (TH.Q a)))
                   -> DsM (Core (TH.Q a))
 
@@ -906,7 +909,7 @@ addTyClTyVarBinds tvs m
 
 -- Produce kinded binder constructors from the Haskell tyvar binders
 --
-repTyVarBndrWithKind :: LHsTyVarBndr Name
+repTyVarBndrWithKind :: LHsTyVarBndr GhcRn
                      -> Core TH.Name -> DsM (Core TH.TyVarBndr)
 repTyVarBndrWithKind (L _ (UserTyVar _)) nm
   = repPlainTV nm
@@ -914,7 +917,7 @@ repTyVarBndrWithKind (L _ (KindedTyVar _ ki)) nm
   = repLKind ki >>= repKindedTV nm
 
 -- | Represent a type variable binder
-repTyVarBndr :: LHsTyVarBndr Name -> DsM (Core TH.TyVarBndr)
+repTyVarBndr :: LHsTyVarBndr GhcRn -> DsM (Core TH.TyVarBndr)
 repTyVarBndr (L _ (UserTyVar (L _ nm)) )= do { nm' <- lookupBinder nm
                                              ; repPlainTV nm' }
 repTyVarBndr (L _ (KindedTyVar (L _ nm) ki)) = do { nm' <- lookupBinder nm
@@ -923,14 +926,14 @@ repTyVarBndr (L _ (KindedTyVar (L _ nm) ki)) = do { nm' <- lookupBinder nm
 
 -- represent a type context
 --
-repLContext :: LHsContext Name -> DsM (Core TH.CxtQ)
+repLContext :: LHsContext GhcRn -> DsM (Core TH.CxtQ)
 repLContext (L _ ctxt) = repContext ctxt
 
-repContext :: HsContext Name -> DsM (Core TH.CxtQ)
+repContext :: HsContext GhcRn -> DsM (Core TH.CxtQ)
 repContext ctxt = do preds <- repList typeQTyConName repLTy ctxt
                      repCtxt preds
 
-repHsSigType :: LHsSigType Name -> DsM (Core TH.TypeQ)
+repHsSigType :: LHsSigType GhcRn -> DsM (Core TH.TypeQ)
 repHsSigType (HsIB { hsib_vars = implicit_tvs
                    , hsib_body = body })
   | (explicit_tvs, ctxt, ty) <- splitLHsSigmaTy body
@@ -946,7 +949,7 @@ repHsSigType (HsIB { hsib_vars = implicit_tvs
          then return th_ty
          else repTForall th_explicit_tvs th_ctxt th_ty }
 
-repHsPatSynSigType :: LHsSigType Name -> DsM (Core TH.TypeQ)
+repHsPatSynSigType :: LHsSigType GhcRn -> DsM (Core TH.TypeQ)
 repHsPatSynSigType (HsIB { hsib_vars = implicit_tvs
                          , hsib_body = body })
   = addTyVarBinds (newTvs implicit_tvs univs) $ \th_univs ->
@@ -965,19 +968,19 @@ repHsPatSynSigType (HsIB { hsib_vars = implicit_tvs
 
     (univs, reqs, exis, provs, ty) = splitLHsPatSynTy body
 
-repHsSigWcType :: LHsSigWcType Name -> DsM (Core TH.TypeQ)
+repHsSigWcType :: LHsSigWcType GhcRn -> DsM (Core TH.TypeQ)
 repHsSigWcType (HsWC { hswc_body = sig1 })
   = repHsSigType sig1
 
 -- yield the representation of a list of types
-repLTys :: [LHsType Name] -> DsM [Core TH.TypeQ]
+repLTys :: [LHsType GhcRn] -> DsM [Core TH.TypeQ]
 repLTys tys = mapM repLTy tys
 
 -- represent a type
-repLTy :: LHsType Name -> DsM (Core TH.TypeQ)
+repLTy :: LHsType GhcRn -> DsM (Core TH.TypeQ)
 repLTy (L _ ty) = repTy ty
 
-repForall :: HsType Name -> DsM (Core TH.TypeQ)
+repForall :: HsType GhcRn -> DsM (Core TH.TypeQ)
 -- Arg of repForall is always HsForAllTy or HsQualTy
 repForall ty
  | (tvs, ctxt, tau) <- splitLHsSigmaTy (noLoc ty)
@@ -987,7 +990,7 @@ repForall ty
       ; ty1    <- repLTy tau
       ; repTForall bndrs ctxt1 ty1 }
 
-repTy :: HsType Name -> DsM (Core TH.TypeQ)
+repTy :: HsType GhcRn -> DsM (Core TH.TypeQ)
 repTy ty@(HsForAllTy {}) = repForall ty
 repTy ty@(HsQualTy {})   = repForall ty
 
@@ -1066,7 +1069,7 @@ repTyLit (HsStrTy _ s) = do { s' <- mkStringExprFS s
 
 -- represent a kind
 --
-repLKind :: LHsKind Name -> DsM (Core TH.Kind)
+repLKind :: LHsKind GhcRn -> DsM (Core TH.Kind)
 repLKind ki
   = do { let (kis, ki') = splitHsFunType ki
        ; kis_rep <- mapM repLKind kis
@@ -1077,7 +1080,7 @@ repLKind ki
        }
 
 -- | Represent a kind wrapped in a Maybe
-repMaybeLKind :: Maybe (LHsKind Name)
+repMaybeLKind :: Maybe (LHsKind GhcRn)
               -> DsM (Core (Maybe TH.Kind))
 repMaybeLKind Nothing =
     do { coreNothing kindTyConName }
@@ -1085,10 +1088,10 @@ repMaybeLKind (Just ki) =
     do { ki' <- repLKind ki
        ; coreJust kindTyConName ki' }
 
-repNonArrowLKind :: LHsKind Name -> DsM (Core TH.Kind)
+repNonArrowLKind :: LHsKind GhcRn -> DsM (Core TH.Kind)
 repNonArrowLKind (L _ ki) = repNonArrowKind ki
 
-repNonArrowKind :: HsKind Name -> DsM (Core TH.Kind)
+repNonArrowKind :: HsKind GhcRn -> DsM (Core TH.Kind)
 repNonArrowKind (HsTyVar _ (L _ name))
   | isLiftedTypeKindTyConName name       = repKStar
   | name `hasKey` constraintKindTyConKey = repKConstraint
@@ -1118,7 +1121,7 @@ repRole (L _ Nothing)                 = rep2 inferRName []
 --              Splices
 -----------------------------------------------------------------------------
 
-repSplice :: HsSplice Name -> DsM (Core a)
+repSplice :: HsSplice GhcRn -> DsM (Core a)
 -- See Note [How brackets and nested splices are handled] in TcSplice
 -- We return a CoreExpr of any old type; the context should know
 repSplice (HsTypedSplice   _ n _) = rep_splice n
@@ -1139,16 +1142,16 @@ rep_splice splice_name
 --              Expressions
 -----------------------------------------------------------------------------
 
-repLEs :: [LHsExpr Name] -> DsM (Core [TH.ExpQ])
+repLEs :: [LHsExpr GhcRn] -> DsM (Core [TH.ExpQ])
 repLEs es = repList expQTyConName repLE es
 
 -- FIXME: some of these panics should be converted into proper error messages
 --        unless we can make sure that constructs, which are plainly not
 --        supported in TH already lead to error messages at an earlier stage
-repLE :: LHsExpr Name -> DsM (Core TH.ExpQ)
+repLE :: LHsExpr GhcRn -> DsM (Core TH.ExpQ)
 repLE (L loc e) = putSrcSpanDs loc (repE e)
 
-repE :: HsExpr Name -> DsM (Core TH.ExpQ)
+repE :: HsExpr GhcRn -> DsM (Core TH.ExpQ)
 repE (HsVar (L _ x))            =
   do { mb_val <- dsLookupMetaEnv x
      ; case mb_val of
@@ -1284,7 +1287,7 @@ repE e                     = notHandled "Expression form" (ppr e)
 -----------------------------------------------------------------------------
 -- Building representations of auxillary structures like Match, Clause, Stmt,
 
-repMatchTup ::  LMatch Name (LHsExpr Name) -> DsM (Core TH.MatchQ)
+repMatchTup ::  LMatch GhcRn (LHsExpr GhcRn) -> DsM (Core TH.MatchQ)
 repMatchTup (L _ (Match _ [p] _ (GRHSs guards (L _ wheres)))) =
   do { ss1 <- mkGenSyms (collectPatBinders p)
      ; addBinds ss1 $ do {
@@ -1296,7 +1299,7 @@ repMatchTup (L _ (Match _ [p] _ (GRHSs guards (L _ wheres)))) =
      ; wrapGenSyms (ss1++ss2) match }}}
 repMatchTup _ = panic "repMatchTup: case alt with more than one arg"
 
-repClauseTup ::  LMatch Name (LHsExpr Name) -> DsM (Core TH.ClauseQ)
+repClauseTup ::  LMatch GhcRn (LHsExpr GhcRn) -> DsM (Core TH.ClauseQ)
 repClauseTup (L _ (Match _ ps _ (GRHSs guards (L _ wheres)))) =
   do { ss1 <- mkGenSyms (collectPatsBinders ps)
      ; addBinds ss1 $ do {
@@ -1307,7 +1310,7 @@ repClauseTup (L _ (Match _ ps _ (GRHSs guards (L _ wheres)))) =
      ; clause <- repClause ps1 gs ds
      ; wrapGenSyms (ss1++ss2) clause }}}
 
-repGuards ::  [LGRHS Name (LHsExpr Name)] ->  DsM (Core TH.BodyQ)
+repGuards ::  [LGRHS GhcRn (LHsExpr GhcRn)] ->  DsM (Core TH.BodyQ)
 repGuards [L _ (GRHS [] e)]
   = do {a <- repLE e; repNormal a }
 repGuards other
@@ -1316,7 +1319,8 @@ repGuards other
        ; gd <- repGuarded (nonEmptyCoreList ys)
        ; wrapGenSyms (concat xs) gd }
 
-repLGRHS :: LGRHS Name (LHsExpr Name) -> DsM ([GenSymBind], (Core (TH.Q (TH.Guard, TH.Exp))))
+repLGRHS :: LGRHS GhcRn (LHsExpr GhcRn)
+         -> DsM ([GenSymBind], (Core (TH.Q (TH.Guard, TH.Exp))))
 repLGRHS (L _ (GRHS [L _ (BodyStmt e1 _ _ _)] e2))
   = do { guarded <- repLNormalGE e1 e2
        ; return ([], guarded) }
@@ -1326,19 +1330,20 @@ repLGRHS (L _ (GRHS ss rhs))
        ; guarded <- repPatGE (nonEmptyCoreList ss') rhs'
        ; return (gs, guarded) }
 
-repFields :: HsRecordBinds Name -> DsM (Core [TH.Q TH.FieldExp])
+repFields :: HsRecordBinds GhcRn -> DsM (Core [TH.Q TH.FieldExp])
 repFields (HsRecFields { rec_flds = flds })
   = repList fieldExpQTyConName rep_fld flds
   where
-    rep_fld :: LHsRecField Name (LHsExpr Name) -> DsM (Core (TH.Q TH.FieldExp))
+    rep_fld :: LHsRecField GhcRn (LHsExpr GhcRn)
+            -> DsM (Core (TH.Q TH.FieldExp))
     rep_fld (L _ fld) = do { fn <- lookupLOcc (hsRecFieldSel fld)
                            ; e  <- repLE (hsRecFieldArg fld)
                            ; repFieldExp fn e }
 
-repUpdFields :: [LHsRecUpdField Name] -> DsM (Core [TH.Q TH.FieldExp])
+repUpdFields :: [LHsRecUpdField GhcRn] -> DsM (Core [TH.Q TH.FieldExp])
 repUpdFields = repList fieldExpQTyConName rep_fld
   where
-    rep_fld :: LHsRecUpdField Name -> DsM (Core (TH.Q TH.FieldExp))
+    rep_fld :: LHsRecUpdField GhcRn -> DsM (Core (TH.Q TH.FieldExp))
     rep_fld (L l fld) = case unLoc (hsRecFieldLbl fld) of
       Unambiguous _ sel_name -> do { fn <- lookupLOcc (L l sel_name)
                                    ; e  <- repLE (hsRecFieldArg fld)
@@ -1372,10 +1377,10 @@ repUpdFields = repList fieldExpQTyConName rep_fld
 -- The helper function repSts computes the translation of each sub expression
 -- and a bunch of prefix bindings denoting the dynamic renaming.
 
-repLSts :: [LStmt Name (LHsExpr Name)] -> DsM ([GenSymBind], [Core TH.StmtQ])
+repLSts :: [LStmt GhcRn (LHsExpr GhcRn)] -> DsM ([GenSymBind], [Core TH.StmtQ])
 repLSts stmts = repSts (map unLoc stmts)
 
-repSts :: [Stmt Name (LHsExpr Name)] -> DsM ([GenSymBind], [Core TH.StmtQ])
+repSts :: [Stmt GhcRn (LHsExpr GhcRn)] -> DsM ([GenSymBind], [Core TH.StmtQ])
 repSts (BindStmt p e _ _ _ : ss) =
    do { e2 <- repLE e
       ; ss1 <- mkGenSyms (collectPatBinders p)
@@ -1402,7 +1407,8 @@ repSts (ParStmt stmt_blocks _ _ _ : ss) =
       ; (ss2, zs) <- addBinds ss1 (repSts ss)
       ; return (ss1++ss2, z : zs) }
    where
-     rep_stmt_block :: ParStmtBlock Name Name -> DsM ([GenSymBind], Core [TH.StmtQ])
+     rep_stmt_block :: ParStmtBlock GhcRn GhcRn
+                    -> DsM ([GenSymBind], Core [TH.StmtQ])
      rep_stmt_block (ParStmtBlock stmts _ _) =
        do { (ss1, zs) <- repSts (map unLoc stmts)
           ; zs1 <- coreList stmtQTyConName zs
@@ -1419,7 +1425,7 @@ repSts other = notHandled "Exotic statement" (ppr other)
 --                      Bindings
 -----------------------------------------------------------
 
-repBinds :: HsLocalBinds Name -> DsM ([GenSymBind], Core [TH.DecQ])
+repBinds :: HsLocalBinds GhcRn -> DsM ([GenSymBind], Core [TH.DecQ])
 repBinds EmptyLocalBinds
   = do  { core_list <- coreList decQTyConName []
         ; return ([], core_list) }
@@ -1439,7 +1445,7 @@ repBinds (HsValBinds decs)
                                 (de_loc (sort_by_loc prs))
         ; return (ss, core_list) }
 
-rep_val_binds :: HsValBinds Name -> DsM [(SrcSpan, Core TH.DecQ)]
+rep_val_binds :: HsValBinds GhcRn -> DsM [(SrcSpan, Core TH.DecQ)]
 -- Assumes: all the binders of the binding are already in the meta-env
 rep_val_binds (ValBindsOut binds sigs)
  = do { core1 <- rep_binds' (unionManyBags (map snd binds))
@@ -1448,14 +1454,14 @@ rep_val_binds (ValBindsOut binds sigs)
 rep_val_binds (ValBindsIn _ _)
  = panic "rep_val_binds: ValBindsIn"
 
-rep_binds :: LHsBinds Name -> DsM [Core TH.DecQ]
+rep_binds :: LHsBinds GhcRn -> DsM [Core TH.DecQ]
 rep_binds binds = do { binds_w_locs <- rep_binds' binds
                      ; return (de_loc (sort_by_loc binds_w_locs)) }
 
-rep_binds' :: LHsBinds Name -> DsM [(SrcSpan, Core TH.DecQ)]
+rep_binds' :: LHsBinds GhcRn -> DsM [(SrcSpan, Core TH.DecQ)]
 rep_binds' = mapM rep_bind . bagToList
 
-rep_bind :: LHsBind Name -> DsM (SrcSpan, Core TH.DecQ)
+rep_bind :: LHsBind GhcRn -> DsM (SrcSpan, Core TH.DecQ)
 -- Assumes: all the binders of the binding are already in the meta-env
 
 -- Note GHC treats declarations of a variable (not a pattern)
@@ -1571,7 +1577,7 @@ repRecordPatSynArgs :: Core [TH.Name]
                     -> DsM (Core TH.PatSynArgsQ)
 repRecordPatSynArgs (MkC sels) = rep2 recordPatSynName [sels]
 
-repPatSynDir :: HsPatSynDir Name -> DsM (Core TH.PatSynDirQ)
+repPatSynDir :: HsPatSynDir GhcRn -> DsM (Core TH.PatSynDirQ)
 repPatSynDir Unidirectional        = rep2 unidirPatSynName []
 repPatSynDir ImplicitBidirectional = rep2 implBidirPatSynName []
 repPatSynDir (ExplicitBidirectional (MG { mg_alts = L _ clauses }))
@@ -1606,7 +1612,7 @@ repExplBidirPatSynDir (MkC cls) = rep2 explBidirPatSynName [cls]
 -- Haskell Template's Meta.Exp type so we punt if it isn't a simple thing like
 -- (\ p1 .. pn -> exp) by causing an error.
 
-repLambda :: LMatch Name (LHsExpr Name) -> DsM (Core TH.ExpQ)
+repLambda :: LMatch GhcRn (LHsExpr GhcRn) -> DsM (Core TH.ExpQ)
 repLambda (L _ (Match _ ps _ (GRHSs [L _ (GRHS [] e)] (L _ EmptyLocalBinds))))
  = do { let bndrs = collectPatsBinders ps ;
       ; ss  <- mkGenSyms bndrs
@@ -1625,13 +1631,13 @@ repLambda (L _ m) = notHandled "Guarded labmdas" (pprMatch m)
 -- variable should already appear in the environment.
 
 -- Process a list of patterns
-repLPs :: [LPat Name] -> DsM (Core [TH.PatQ])
+repLPs :: [LPat GhcRn] -> DsM (Core [TH.PatQ])
 repLPs ps = repList patQTyConName repLP ps
 
-repLP :: LPat Name -> DsM (Core TH.PatQ)
+repLP :: LPat GhcRn -> DsM (Core TH.PatQ)
 repLP (L _ p) = repP p
 
-repP :: Pat Name -> DsM (Core TH.PatQ)
+repP :: Pat GhcRn -> DsM (Core TH.PatQ)
 repP (WildPat _)       = repPwild
 repP (LitPat l)        = do { l2 <- repLiteral l; repPlit l2 }
 repP (VarPat (L _ x))  = do { x' <- lookupBinder x; repPvar x' }
@@ -1656,7 +1662,7 @@ repP (ConPatIn dc details)
                                 repPinfix p1' con_str p2' }
    }
  where
-   rep_fld :: LHsRecField Name (LPat Name) -> DsM (Core (TH.Name,TH.PatQ))
+   rep_fld :: LHsRecField GhcRn (LPat GhcRn) -> DsM (Core (TH.Name,TH.PatQ))
    rep_fld (L _ fld) = do { MkC v <- lookupLOcc (hsRecFieldSel fld)
                           ; MkC p <- repLP (hsRecFieldArg fld)
                           ; rep2 fieldPatName [v,p] }
@@ -1977,7 +1983,8 @@ repNormal :: Core TH.ExpQ -> DsM (Core TH.BodyQ)
 repNormal (MkC e) = rep2 normalBName [e]
 
 ------------ Guards ----
-repLNormalGE :: LHsExpr Name -> LHsExpr Name -> DsM (Core (TH.Q (TH.Guard, TH.Exp)))
+repLNormalGE :: LHsExpr GhcRn -> LHsExpr GhcRn
+             -> DsM (Core (TH.Q (TH.Guard, TH.Exp)))
 repLNormalGE g e = do g' <- repLE g
                       e' <- repLE e
                       repNormalGE g' e'
@@ -2171,15 +2178,15 @@ repCtxt :: Core [TH.PredQ] -> DsM (Core TH.CxtQ)
 repCtxt (MkC tys) = rep2 cxtName [tys]
 
 repDataCon :: Located Name
-           -> HsConDeclDetails Name
+           -> HsConDeclDetails GhcRn
            -> DsM (Core TH.ConQ)
 repDataCon con details
     = do con' <- lookupLOcc con -- See Note [Binders and occurrences]
          repConstr details Nothing [con']
 
 repGadtDataCons :: [Located Name]
-                -> HsConDeclDetails Name
-                -> LHsType Name
+                -> HsConDeclDetails GhcRn
+                -> LHsType GhcRn
                 -> DsM (Core TH.ConQ)
 repGadtDataCons cons details res_ty
     = do cons' <- mapM lookupLOcc cons -- See Note [Binders and occurrences]
@@ -2190,8 +2197,8 @@ repGadtDataCons cons details res_ty
 --     argument is a singleton list
 --   * for GADTs data constructors second argument is (Just return_type) and
 --     third argument is a non-empty list
-repConstr :: HsConDeclDetails Name
-          -> Maybe (LHsType Name)
+repConstr :: HsConDeclDetails GhcRn
+          -> Maybe (LHsType GhcRn)
           -> [Core TH.Name]
           -> DsM (Core TH.ConQ)
 repConstr (PrefixCon ps) Nothing [con]
@@ -2216,7 +2223,7 @@ repConstr (RecCon (L _ ips)) resTy cons
     where
       rep_ip (L _ ip) = mapM (rep_one_ip (cd_fld_type ip)) (cd_fld_names ip)
 
-      rep_one_ip :: LBangType Name -> LFieldOcc Name -> DsM (Core a)
+      rep_one_ip :: LBangType GhcRn -> LFieldOcc GhcRn -> DsM (Core a)
       rep_one_ip t n = do { MkC v  <- lookupOcc (selectorFieldOcc $ unLoc n)
                           ; MkC ty <- repBangTy  t
                           ; rep2 varBangTypeName [v,ty] }
@@ -2359,7 +2366,7 @@ repTyVarSig (MkC bndr) = rep2 tyVarSigName [bndr]
 ----------------------------------------------------------
 --              Literals
 
-repLiteral :: HsLit -> DsM (Core TH.Lit)
+repLiteral :: HsLit GhcRn -> DsM (Core TH.Lit)
 repLiteral (HsStringPrim _ bs)
   = do dflags   <- getDynFlags
        word8_ty <- lookupType word8TyConName
@@ -2371,9 +2378,9 @@ repLiteral lit
   = do lit' <- case lit of
                    HsIntPrim _ i    -> mk_integer i
                    HsWordPrim _ w   -> mk_integer w
-                   HsInt i          -> mk_integer (il_value i)
-                   HsFloatPrim r    -> mk_rational r
-                   HsDoublePrim r   -> mk_rational r
+                   HsInt _ i        -> mk_integer (il_value i)
+                   HsFloatPrim _ r  -> mk_rational r
+                   HsDoublePrim _ r -> mk_rational r
                    HsCharPrim _ c   -> mk_char c
                    _ -> return lit
        lit_expr <- dsLit lit'
@@ -2383,38 +2390,38 @@ repLiteral lit
   where
     mb_lit_name = case lit of
                  HsInteger _ _ _  -> Just integerLName
-                 HsInt _          -> Just integerLName
+                 HsInt _ _        -> Just integerLName
                  HsIntPrim _ _    -> Just intPrimLName
                  HsWordPrim _ _   -> Just wordPrimLName
-                 HsFloatPrim _    -> Just floatPrimLName
-                 HsDoublePrim _   -> Just doublePrimLName
+                 HsFloatPrim _ _  -> Just floatPrimLName
+                 HsDoublePrim _ _ -> Just doublePrimLName
                  HsChar _ _       -> Just charLName
                  HsCharPrim _ _   -> Just charPrimLName
                  HsString _ _     -> Just stringLName
-                 HsRat _ _        -> Just rationalLName
+                 HsRat _ _ _      -> Just rationalLName
                  _                -> Nothing
 
-mk_integer :: Integer -> DsM HsLit
+mk_integer :: Integer -> DsM (HsLit GhcRn)
 mk_integer  i = do integer_ty <- lookupType integerTyConName
-                   return $ HsInteger NoSourceText i integer_ty
+                   return $ HsInteger noSourceText i integer_ty
 
-mk_rational :: FractionalLit -> DsM HsLit
+mk_rational :: FractionalLit -> DsM (HsLit GhcRn)
 mk_rational r = do rat_ty <- lookupType rationalTyConName
-                   return $ HsRat r rat_ty
-mk_string :: FastString -> DsM HsLit
-mk_string s = return $ HsString NoSourceText s
+                   return $ HsRat def r rat_ty
+mk_string :: FastString -> DsM (HsLit GhcRn)
+mk_string s = return $ HsString noSourceText s
 
-mk_char :: Char -> DsM HsLit
-mk_char c = return $ HsChar NoSourceText c
+mk_char :: Char -> DsM (HsLit GhcRn)
+mk_char c = return $ HsChar noSourceText c
 
-repOverloadedLiteral :: HsOverLit Name -> DsM (Core TH.Lit)
+repOverloadedLiteral :: HsOverLit GhcRn -> DsM (Core TH.Lit)
 repOverloadedLiteral (OverLit { ol_val = val})
   = do { lit <- mk_lit val; repLiteral lit }
         -- The type Rational will be in the environment, because
         -- the smart constructor 'TH.Syntax.rationalL' uses it in its type,
         -- and rationalL is sucked in when any TH stuff is used
 
-mk_lit :: OverLitVal -> DsM HsLit
+mk_lit :: OverLitVal -> DsM (HsLit GhcRn)
 mk_lit (HsIntegral i)     = mk_integer  (il_value i)
 mk_lit (HsFractional f)   = mk_rational f
 mk_lit (HsIsString _ s)   = mk_string   s
@@ -2443,12 +2450,12 @@ repUnboundVar (MkC name) = rep2 unboundVarEName [name]
 -- turn a list of patterns into a single pattern matching a list
 
 repList :: Name -> (a  -> DsM (Core b))
-                -> [a] -> DsM (Core [b])
+                    -> [a] -> DsM (Core [b])
 repList tc_name f args
   = do { args1 <- mapM f args
        ; coreList tc_name args1 }
 
-coreList :: Name        -- Of the TyCon of the element type
+coreList :: Name    -- Of the TyCon of the element type
          -> [Core a] -> DsM (Core [a])
 coreList tc_name es
   = do { elt_ty <- lookupType tc_name; return (coreList' elt_ty es) }
index 81a8e35..c3a2973 100644 (file)
@@ -105,7 +105,7 @@ instance Outputable DsMatchContext where
   ppr (DsMatchContext hs_match ss) = ppr ss <+> pprMatchContext hs_match
 
 data EquationInfo
-  = EqnInfo { eqn_pats :: [Pat Id],     -- The patterns for an eqn
+  = EqnInfo { eqn_pats :: [Pat GhcTc],  -- The patterns for an eqn
               eqn_rhs  :: MatchResult } -- What to do after match
 
 instance Outputable EquationInfo where
index db757d6..4ef279f 100644 (file)
@@ -92,7 +92,7 @@ hand, which should indeed be bound to the pattern as a whole, then use it;
 otherwise, make one up.
 -}
 
-selectSimpleMatchVarL :: LPat Id -> DsM Id
+selectSimpleMatchVarL :: LPat GhcTc -> DsM Id
 selectSimpleMatchVarL pat = selectMatchVar (unLoc pat)
 
 -- (selectMatchVars ps tys) chooses variables of type tys
@@ -111,10 +111,10 @@ selectSimpleMatchVarL pat = selectMatchVar (unLoc pat)
 --    Then we must not choose (x::Int) as the matching variable!
 -- And nowadays we won't, because the (x::Int) will be wrapped in a CoPat
 
-selectMatchVars :: [Pat Id] -> DsM [Id]
+selectMatchVars :: [Pat GhcTc] -> DsM [Id]
 selectMatchVars ps = mapM selectMatchVar ps
 
-selectMatchVar :: Pat Id -> DsM Id
+selectMatchVar :: Pat GhcTc -> DsM Id
 selectMatchVar (BangPat pat) = selectMatchVar (unLoc pat)
 selectMatchVar (LazyPat pat) = selectMatchVar (unLoc pat)
 selectMatchVar (ParPat pat)  = selectMatchVar (unLoc pat)
@@ -174,7 +174,7 @@ The ``equation info'' used by @match@ is relatively complicated and
 worthy of a type synonym and a few handy functions.
 -}
 
-firstPat :: EquationInfo -> Pat Id
+firstPat :: EquationInfo -> Pat GhcTc
 firstPat eqn = ASSERT( notNull (eqn_pats eqn) ) head (eqn_pats eqn)
 
 shiftEqns :: [EquationInfo] -> [EquationInfo]
@@ -255,7 +255,7 @@ mkGuardedMatchResult pred_expr (MatchResult _ body_fn)
   = MatchResult CanFail (\fail -> do body <- body_fn fail
                                      return (mkIfThenElse pred_expr body fail))
 
-mkCoPrimCaseMatchResult :: Id                        -- Scrutinee
+mkCoPrimCaseMatchResult :: Id                  -- Scrutinee
                         -> Type                      -- Type of the case
                         -> [(Literal, MatchResult)]  -- Alternatives
                         -> MatchResult               -- Literals are all unlifted
@@ -414,7 +414,8 @@ mkDataConCase var ty alts@(alt1:_) = MatchResult fail_flag mk_case
 --   parallel arrays, which are introduced by `tidy1' in the `PArrPat'
 --   case
 --
-mkPArrCase :: DynFlags -> Id -> Type -> [CaseAlt DataCon] -> CoreExpr -> DsM CoreExpr
+mkPArrCase :: DynFlags -> Id -> Type -> [CaseAlt DataCon] -> CoreExpr
+           -> DsM CoreExpr
 mkPArrCase dflags var ty sorted_alts fail = do
     lengthP <- dsDPHBuiltin lengthPVar
     alt <- unboxAlt
@@ -725,7 +726,7 @@ work out well:
 -}
 
 mkSelectorBinds :: [[Tickish Id]] -- ^ ticks to add, possibly
-                -> LPat Id        -- ^ The pattern
+                -> LPat GhcTc     -- ^ The pattern
                 -> CoreExpr       -- ^ Expression to which the pattern is bound
                 -> DsM (Id,[(Id,CoreExpr)])
                 -- ^ Id the rhs is bound to, for desugaring strict
@@ -814,31 +815,31 @@ is_triv_pat _           = False
 *                                                                      *
 ********************************************************************* -}
 
-mkLHsPatTup :: [LPat Id] -> LPat Id
+mkLHsPatTup :: [LPat GhcTc] -> LPat GhcTc
 mkLHsPatTup []     = noLoc $ mkVanillaTuplePat [] Boxed
 mkLHsPatTup [lpat] = lpat
 mkLHsPatTup lpats  = L (getLoc (head lpats)) $
                      mkVanillaTuplePat lpats Boxed
 
-mkLHsVarPatTup :: [Id] -> LPat Id
+mkLHsVarPatTup :: [Id] -> LPat GhcTc
 mkLHsVarPatTup bs  = mkLHsPatTup (map nlVarPat bs)
 
-mkVanillaTuplePat :: [OutPat Id] -> Boxity -> Pat Id
+mkVanillaTuplePat :: [OutPat GhcTc] -> Boxity -> Pat GhcTc
 -- A vanilla tuple pattern simply gets its type from its sub-patterns
 mkVanillaTuplePat pats box = TuplePat pats box (map hsLPatType pats)
 
 -- The Big equivalents for the source tuple expressions
-mkBigLHsVarTupId :: [Id] -> LHsExpr Id
+mkBigLHsVarTupId :: [Id] -> LHsExpr GhcTc
 mkBigLHsVarTupId ids = mkBigLHsTupId (map nlHsVar ids)
 
-mkBigLHsTupId :: [LHsExpr Id] -> LHsExpr Id
+mkBigLHsTupId :: [LHsExpr GhcTc] -> LHsExpr GhcTc
 mkBigLHsTupId = mkChunkified mkLHsTupleExpr
 
 -- The Big equivalents for the source tuple patterns
-mkBigLHsVarPatTupId :: [Id] -> LPat Id
+mkBigLHsVarPatTupId :: [Id] -> LPat GhcTc
 mkBigLHsVarPatTupId bs = mkBigLHsPatTupId (map nlVarPat bs)
 
-mkBigLHsPatTupId :: [LPat Id] -> LPat Id
+mkBigLHsPatTupId :: [LPat GhcTc] -> LPat GhcTc
 mkBigLHsPatTupId = mkChunkified mkLHsPatTup
 
 {-
index 1416620..19f7036 100644 (file)
@@ -7,6 +7,7 @@ The @match@ function
 -}
 
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE TypeFamilies #-}
 
 module Match ( match, matchEquations, matchWrapper, matchSimply, matchSinglePat ) where
 
@@ -304,12 +305,12 @@ matchOverloadedList (var:vars) ty (eqns@(eqn1:_))
 matchOverloadedList _ _ _ = panic "matchOverloadedList"
 
 -- decompose the first pattern and leave the rest alone
-decomposeFirstPat :: (Pat Id -> Pat Id) -> EquationInfo -> EquationInfo
+decomposeFirstPat :: (Pat GhcTc -> Pat GhcTc) -> EquationInfo -> EquationInfo
 decomposeFirstPat extractpat (eqn@(EqnInfo { eqn_pats = pat : pats }))
         = eqn { eqn_pats = extractpat pat : pats}
 decomposeFirstPat _ _ = panic "decomposeFirstPat"
 
-getCoPat, getBangPat, getViewPat, getOLPat :: Pat Id -> Pat Id
+getCoPat, getBangPat, getViewPat, getOLPat :: Pat GhcTc -> Pat GhcTc
 getCoPat (CoPat _ pat _)     = pat
 getCoPat _                   = panic "getCoPat"
 getBangPat (BangPat pat  )   = unLoc pat
@@ -402,10 +403,10 @@ tidyEqnInfo v eqn@(EqnInfo { eqn_pats = pat : pats })
   = do { (wrap, pat') <- tidy1 v pat
        ; return (wrap, eqn { eqn_pats = do pat' : pats }) }
 
-tidy1 :: Id               -- The Id being scrutinised
-      -> Pat Id           -- The pattern against which it is to be matched
-      -> DsM (DsWrapper,  -- Extra bindings to do before the match
-              Pat Id)     -- Equivalent pattern
+tidy1 :: Id                  -- The Id being scrutinised
+      -> Pat GhcTc           -- The pattern against which it is to be matched
+      -> DsM (DsWrapper,     -- Extra bindings to do before the match
+              Pat GhcTc)     -- Equivalent pattern
 
 -------------------------------------------------------
 --      (pat', mr') = tidy1 v pat mr
@@ -501,7 +502,7 @@ tidy1 _ non_interesting_pat
   = return (idDsWrapper, non_interesting_pat)
 
 --------------------
-tidy_bang_pat :: Id -> SrcSpan -> Pat Id -> DsM (DsWrapper, Pat Id)
+tidy_bang_pat :: Id -> SrcSpan -> Pat GhcTc -> DsM (DsWrapper, Pat GhcTc)
 
 -- Discard par/sig under a bang
 tidy_bang_pat v _ (ParPat (L l p))      = tidy_bang_pat v l p
@@ -552,7 +553,7 @@ tidy_bang_pat _ l p = return (idDsWrapper, BangPat (L l p))
 push_bang_into_newtype_arg :: SrcSpan
                            -> Type -- The type of the argument we are pushing
                                    -- onto
-                           -> HsConPatDetails Id -> HsConPatDetails Id
+                           -> HsConPatDetails GhcTc -> HsConPatDetails GhcTc
 -- See Note [Bang patterns and newtypes]
 -- We are transforming   !(N p)   into   (N !p)
 push_bang_into_newtype_arg l _ty (PrefixCon (arg:args))
@@ -695,10 +696,10 @@ Call @match@ with all of this information!
 \end{enumerate}
 -}
 
-matchWrapper :: HsMatchContext Name         -- For shadowing warning messages
-             -> Maybe (LHsExpr Id)          -- The scrutinee, if we check a case expr
-             -> MatchGroup Id (LHsExpr Id)  -- Matches being desugared
-             -> DsM ([Id], CoreExpr)        -- Results
+matchWrapper :: HsMatchContext Name    -- For shadowing warning messages
+             -> Maybe (LHsExpr GhcTc)  -- The scrutinee, if we check a case expr
+             -> MatchGroup GhcTc (LHsExpr GhcTc)   -- Matches being desugared
+             -> DsM ([Id], CoreExpr)   -- Results
 
 {-
  There is one small problem with the Lambda Patterns, when somebody
@@ -788,7 +789,7 @@ pattern. It returns an expression.
 
 matchSimply :: CoreExpr                 -- Scrutinee
             -> HsMatchContext Name      -- Match kind
-            -> LPat Id                  -- Pattern it should match
+            -> LPat GhcTc               -- Pattern it should match
             -> CoreExpr                 -- Return this if it matches
             -> CoreExpr                 -- Return this if it doesn't
             -> DsM CoreExpr
@@ -801,7 +802,7 @@ matchSimply scrut hs_ctx pat result_expr fail_expr = do
     match_result' <- matchSinglePat scrut hs_ctx pat rhs_ty match_result
     extractMatchResult match_result' fail_expr
 
-matchSinglePat :: CoreExpr -> HsMatchContext Name -> LPat Id
+matchSinglePat :: CoreExpr -> HsMatchContext Name -> LPat GhcTc
                -> Type -> MatchResult -> DsM MatchResult
 -- matchSinglePat ensures that the scrutinee is a variable
 -- and then calls match_single_pat_var
@@ -820,7 +821,7 @@ matchSinglePat scrut hs_ctx pat ty match_result
        ; return (adjustMatchResult (bindNonRec var scrut) match_result') }
 
 match_single_pat_var :: Id   -- See Note [Match Ids]
-                     -> HsMatchContext Name -> LPat Id
+                     -> HsMatchContext Name -> LPat GhcTc
                      -> Type -> MatchResult -> DsM MatchResult
 match_single_pat_var var ctx pat ty match_result
   = ASSERT2( isInternalName (idName var), ppr var )
@@ -856,7 +857,7 @@ data PatGroup
   | PgBang              -- Bang patterns
   | PgCo Type           -- Coercion patterns; the type is the type
                         --      of the pattern *inside*
-  | PgView (LHsExpr Id) -- view pattern (e -> p):
+  | PgView (LHsExpr GhcTc) -- view pattern (e -> p):
                         -- the LHsExpr is the expression e
            Type         -- the Type is the type of p (equivalently, the result type of e)
   | PgOverloadedList
@@ -985,14 +986,14 @@ sameGroup _          _          = False
 -- NB we can't assume that the two view expressions have the same type.  Consider
 --   f (e1 -> True) = ...
 --   f (e2 -> "hi") = ...
-viewLExprEq :: (LHsExpr Id,Type) -> (LHsExpr Id,Type) -> Bool
+viewLExprEq :: (LHsExpr GhcTc,Type) -> (LHsExpr GhcTc,Type) -> Bool
 viewLExprEq (e1,_) (e2,_) = lexp e1 e2
   where
-    lexp :: LHsExpr Id -> LHsExpr Id -> Bool
+    lexp :: LHsExpr GhcTc -> LHsExpr GhcTc -> Bool
     lexp e e' = exp (unLoc e) (unLoc e')
 
     ---------
-    exp :: HsExpr Id -> HsExpr Id -> Bool
+    exp :: HsExpr GhcTc -> HsExpr GhcTc -> Bool
     -- real comparison is on HsExpr's
     -- strip parens
     exp (HsPar (L _ e)) e'   = exp e e'
@@ -1037,7 +1038,7 @@ viewLExprEq (e1,_) (e2,_) = lexp e1 e2
     exp _ _  = False
 
     ---------
-    syn_exp :: SyntaxExpr Id -> SyntaxExpr Id -> Bool
+    syn_exp :: SyntaxExpr GhcTc -> SyntaxExpr GhcTc -> Bool
     syn_exp (SyntaxExpr { syn_expr      = expr1
                         , syn_arg_wraps = arg_wraps1
                         , syn_res_wrap  = res_wrap1 })
@@ -1084,7 +1085,7 @@ viewLExprEq (e1,_) (e2,_) = lexp e1 e2
     eq_list _  (_:_)  []     = False
     eq_list eq (x:xs) (y:ys) = eq x y && eq_list eq xs ys
 
-patGroup :: DynFlags -> Pat Id -> PatGroup
+patGroup :: DynFlags -> Pat GhcTc -> PatGroup
 patGroup _ (ConPatOut { pat_con = L _ con
                       , pat_arg_tys = tys })
  | RealDataCon dcon <- con              = PgCon dcon
index 31bd351..4096b9c 100644 (file)
@@ -5,6 +5,7 @@ import DsMonad  ( DsM, EquationInfo, MatchResult )
 import CoreSyn  ( CoreExpr )
 import HsSyn    ( LPat, HsMatchContext, MatchGroup, LHsExpr )
 import Name     ( Name )
+import HsExtension ( GhcTc )
 
 match   :: [Id]
         -> Type
@@ -13,14 +14,14 @@ match   :: [Id]
 
 matchWrapper
         :: HsMatchContext Name
-        -> Maybe (LHsExpr Id)
-        -> MatchGroup Id (LHsExpr Id)
+        -> Maybe (LHsExpr GhcTc)
+        -> MatchGroup GhcTc (LHsExpr GhcTc)
         -> DsM ([Id], CoreExpr)
 
 matchSimply
         :: CoreExpr
         -> HsMatchContext Name
-        -> LPat Id
+        -> LPat GhcTc
         -> CoreExpr
         -> CoreExpr
         -> DsM CoreExpr
@@ -28,7 +29,7 @@ matchSimply
 matchSinglePat
         :: CoreExpr
         -> HsMatchContext Name
-        -> LPat Id
+        -> LPat GhcTc
         -> Type
         -> MatchResult
         -> DsM MatchResult
index 47d1276..7923ae4 100644 (file)
@@ -7,6 +7,7 @@ Pattern-matching constructors
 -}
 
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE TypeFamilies #-}
 
 module MatchCon ( matchConFamily, matchPatSyn ) where
 
@@ -112,7 +113,7 @@ matchPatSyn (var:vars) ty eqns
         _ -> panic "matchPatSyn: not PatSynCon"
 matchPatSyn _ _ _ = panic "matchPatSyn []"
 
-type ConArgPats = HsConDetails (LPat Id) (HsRecFields Id (LPat Id))
+type ConArgPats = HsConDetails (LPat GhcTc) (HsRecFields GhcTc (LPat GhcTc))
 
 matchOneConLike :: [Id]
                 -> Type
@@ -198,7 +199,8 @@ compatible_pats (RecCon flds1, _) _                 = null (rec_flds flds1)
 compatible_pats _                 (RecCon flds2, _) = null (rec_flds flds2)
 compatible_pats _                 _                 = True -- Prefix or infix con
 
-same_fields :: HsRecFields Id (LPat Id) -> HsRecFields Id (LPat Id) -> Bool
+same_fields :: HsRecFields GhcTc (LPat GhcTc) -> HsRecFields GhcTc (LPat GhcTc)
+            -> Bool
 same_fields flds1 flds2
   = all2 (\(L _ f1) (L _ f2)
                           -> unLoc (hsRecFieldId f1) == unLoc (hsRecFieldId f2))
@@ -215,7 +217,7 @@ conArgPats :: [Type]      -- Instantiated argument types
                           -- Used only to fill in the types of WildPats, which
                           -- are probably never looked at anyway
            -> ConArgPats
-           -> [Pat Id]
+           -> [Pat GhcTc]
 conArgPats _arg_tys (PrefixCon ps)   = map unLoc ps
 conArgPats _arg_tys (InfixCon p1 p2) = [unLoc p1, unLoc p2]
 conArgPats  arg_tys (RecCon (HsRecFields { rec_flds = rpats }))
index 748de5c..c3ba420 100644 (file)
@@ -74,22 +74,22 @@ For numeric literals, we try to detect there use at a standard type
 See also below where we look for @DictApps@ for \tr{plusInt}, etc.
 -}
 
-dsLit :: HsLit -> DsM CoreExpr
+dsLit :: HsLit GhcRn -> DsM CoreExpr
 dsLit (HsStringPrim _ s) = return (Lit (MachStr s))
 dsLit (HsCharPrim   _ c) = return (Lit (MachChar c))
 dsLit (HsIntPrim    _ i) = return (Lit (MachInt i))
 dsLit (HsWordPrim   _ w) = return (Lit (MachWord w))
 dsLit (HsInt64Prim  _ i) = return (Lit (MachInt64 i))
 dsLit (HsWord64Prim _ w) = return (Lit (MachWord64 w))
-dsLit (HsFloatPrim    f) = return (Lit (MachFloat (fl_value f)))
-dsLit (HsDoublePrim   d) = return (Lit (MachDouble (fl_value d)))
+dsLit (HsFloatPrim  _ f) = return (Lit (MachFloat (fl_value f)))
+dsLit (HsDoublePrim _ d) = return (Lit (MachDouble (fl_value d)))
 dsLit (HsChar _ c)       = return (mkCharExpr c)
 dsLit (HsString _ str)   = mkStringExprFS str
 dsLit (HsInteger _ i _)  = mkIntegerExpr i
-dsLit (HsInt i)          = do dflags <- getDynFlags
+dsLit (HsInt _ i)        = do dflags <- getDynFlags
                               return (mkIntExpr dflags (il_value i))
 
-dsLit (HsRat (FL _ _ val) ty) = do
+dsLit (HsRat (FL _ _ val) ty) = do
   num   <- mkIntegerExpr (numerator val)
   denom <- mkIntegerExpr (denominator val)
   return (mkCoreConApps ratio_data_con [Type integer_ty, num, denom])
@@ -100,12 +100,12 @@ dsLit (HsRat (FL _ _ val) ty) = do
                                    (head (tyConDataCons tycon), i_ty)
                 x -> pprPanic "dsLit" (ppr x)
 
-dsOverLit :: HsOverLit Id -> DsM CoreExpr
+dsOverLit :: HsOverLit GhcTc -> DsM CoreExpr
 dsOverLit lit = do { dflags <- getDynFlags
                    ; warnAboutOverflowedLiterals dflags lit
                    ; dsOverLit' dflags lit }
 
-dsOverLit' :: DynFlags -> HsOverLit Id -> DsM CoreExpr
+dsOverLit' :: DynFlags -> HsOverLit GhcTc -> DsM CoreExpr
 -- Post-typechecker, the HsExpr field of an OverLit contains
 -- (an expression for) the literal value itself
 dsOverLit' dflags (OverLit { ol_val = val, ol_rebindable = rebindable
@@ -153,7 +153,7 @@ conversionNames
  -- We can't easily add fromIntegerName, fromRationalName,
  -- because they are generated by literals
 
-warnAboutOverflowedLiterals :: DynFlags -> HsOverLit Id -> DsM ()
+warnAboutOverflowedLiterals :: DynFlags -> HsOverLit GhcTc -> DsM ()
 warnAboutOverflowedLiterals dflags lit
  | wopt Opt_WarnOverflowedLiterals dflags
  , Just (i, tc) <- getIntegralLit lit
@@ -200,7 +200,8 @@ We get an erroneous suggestion for
 but perhaps that does not matter too much.
 -}
 
-warnAboutEmptyEnumerations :: DynFlags -> LHsExpr Id -> Maybe (LHsExpr Id) -> LHsExpr Id -> DsM ()
+warnAboutEmptyEnumerations :: DynFlags -> LHsExpr GhcTc -> Maybe (LHsExpr GhcTc)
+                           -> LHsExpr GhcTc -> DsM ()
 -- Warns about [2,3 .. 1] which returns the empty list
 -- Only works for integral types, not floating point
 warnAboutEmptyEnumerations dflags fromExpr mThnExpr toExpr
@@ -233,7 +234,7 @@ warnAboutEmptyEnumerations dflags fromExpr mThnExpr toExpr
 
   | otherwise = return ()
 
-getLHsIntegralLit :: LHsExpr Id -> Maybe (Integer, Name)
+getLHsIntegralLit :: LHsExpr GhcTc -> Maybe (Integer, Name)
 -- See if the expression is an Integral literal
 -- Remember to look through automatically-added tick-boxes! (Trac #8384)
 getLHsIntegralLit (L _ (HsPar e))            = getLHsIntegralLit e
@@ -242,7 +243,7 @@ getLHsIntegralLit (L _ (HsBinTick _ _ e))    = getLHsIntegralLit e
 getLHsIntegralLit (L _ (HsOverLit over_lit)) = getIntegralLit over_lit
 getLHsIntegralLit _ = Nothing
 
-getIntegralLit :: HsOverLit Id -> Maybe (Integer, Name)
+getIntegralLit :: HsOverLit GhcTc -> Maybe (Integer, Name)
 getIntegralLit (OverLit { ol_val = HsIntegral i, ol_type = ty })
   | Just tc <- tyConAppTyCon_maybe ty
   = Just (il_value i, tyConName tc)
@@ -256,7 +257,7 @@ getIntegralLit _ = Nothing
 ************************************************************************
 -}
 
-tidyLitPat :: HsLit -> Pat Id
+tidyLitPat :: HsLit GhcTc -> Pat GhcTc
 -- Result has only the following HsLits:
 --      HsIntPrim, HsWordPrim, HsCharPrim, HsFloatPrim
 --      HsDoublePrim, HsStringPrim, HsString
@@ -273,13 +274,14 @@ tidyLitPat (HsString src s)
 tidyLitPat lit = LitPat lit
 
 ----------------
-tidyNPat :: (HsLit -> Pat Id)   -- How to tidy a LitPat
+tidyNPat :: (HsLit GhcTc -> Pat GhcTc)   -- How to tidy a LitPat
                  -- We need this argument because tidyNPat is called
                  -- both by Match and by Check, but they tidy LitPats
                  -- slightly differently; and we must desugar
                  -- literals consistently (see Trac #5117)
-         -> HsOverLit Id -> Maybe (SyntaxExpr Id) -> SyntaxExpr Id -> Type
-         -> Pat Id
+         -> HsOverLit GhcTc -> Maybe (SyntaxExpr GhcTc) -> SyntaxExpr GhcTc
+         -> Type
+         -> Pat GhcTc
 tidyNPat tidy_lit_pat (OverLit val False _ ty) mb_neg _eq outer_ty
         -- False: Take short cuts only if the literal is not using rebindable syntax
         --
@@ -308,7 +310,7 @@ tidyNPat tidy_lit_pat (OverLit val False _ ty) mb_neg _eq outer_ty
     -- type family Id). In these cases, we can't do the short-cut.
     type_change = not (outer_ty `eqType` ty)
 
-    mk_con_pat :: DataCon -> HsLit -> Pat Id
+    mk_con_pat :: DataCon -> HsLit GhcTc -> Pat GhcTc
     mk_con_pat con lit = unLoc (mkPrefixConPat con [noLoc $ LitPat lit] [])
 
     mb_int_lit :: Maybe Integer
@@ -375,7 +377,7 @@ matchLiterals (var:vars) ty sub_groups
 matchLiterals [] _ _ = panic "matchLiterals []"
 
 ---------------------------
-hsLitKey :: DynFlags -> HsLit -> Literal
+hsLitKey :: DynFlags -> HsLit GhcTc -> Literal
 -- Get the Core literal corresponding to a HsLit.
 -- It only works for primitive types and strings;
 -- others have been removed by tidy
@@ -390,8 +392,8 @@ hsLitKey dflags (HsWordPrim   _ w) = mkMachWordWrap dflags w
 hsLitKey _      (HsInt64Prim  _ i) = mkMachInt64Wrap       i
 hsLitKey _      (HsWord64Prim _ w) = mkMachWord64Wrap      w
 hsLitKey _      (HsCharPrim   _ c) = mkMachChar            c
-hsLitKey _      (HsFloatPrim    f) = mkMachFloat           (fl_value f)
-hsLitKey _      (HsDoublePrim   d) = mkMachDouble          (fl_value d)
+hsLitKey _      (HsFloatPrim  _ f) = mkMachFloat           (fl_value f)
+hsLitKey _      (HsDoublePrim _ d) = mkMachDouble          (fl_value d)
 hsLitKey _      (HsString _ s)     = MachStr (fastStringToByteString s)
 hsLitKey _      l                  = pprPanic "hsLitKey" (ppr l)
 
index 8c3df96..e9af145 100644 (file)
@@ -56,15 +56,15 @@ data PmExpr = PmExprVar   Name
             | PmExprCon   ConLike [PmExpr]
             | PmExprLit   PmLit
             | PmExprEq    PmExpr PmExpr  -- Syntactic equality
-            | PmExprOther (HsExpr Id)    -- Note [PmExprOther in PmExpr]
+            | PmExprOther (HsExpr GhcTc)  -- Note [PmExprOther in PmExpr]
 
 
 mkPmExprData :: DataCon -> [PmExpr] -> PmExpr
 mkPmExprData dc args = PmExprCon (RealDataCon dc) args
 
 -- | Literals (simple and overloaded ones) for pattern match checking.
-data PmLit = PmSLit HsLit                                    -- simple
-           | PmOLit Bool {- is it negated? -} (HsOverLit Id) -- overloaded
+data PmLit = PmSLit (HsLit GhcTc)                               -- simple
+           | PmOLit Bool {- is it negated? -} (HsOverLit GhcTc) -- overloaded
 
 -- | Equality between literals for pattern match checking.
 eqPmLit :: PmLit -> PmLit -> Bool
@@ -229,10 +229,10 @@ substComplexEq x e (ex, ey)
 -- -----------------------------------------------------------------------
 -- ** Lift source expressions (HsExpr Id) to PmExpr
 
-lhsExprToPmExpr :: LHsExpr Id -> PmExpr
+lhsExprToPmExpr :: LHsExpr GhcTc -> PmExpr
 lhsExprToPmExpr (L _ e) = hsExprToPmExpr e
 
-hsExprToPmExpr :: HsExpr Id -> PmExpr
+hsExprToPmExpr :: HsExpr GhcTc -> PmExpr
 
 hsExprToPmExpr (HsVar         x) = PmExprVar (idName (unLoc x))
 hsExprToPmExpr (HsConLikeOut  c) = PmExprVar (conLikeName c)
@@ -282,7 +282,7 @@ hsExprToPmExpr (ExprWithTySigOut  e _) = lhsExprToPmExpr e
 hsExprToPmExpr (HsWrap            _ e) =  hsExprToPmExpr e
 hsExprToPmExpr e = PmExprOther e -- the rest are not handled by the oracle
 
-synExprToPmExpr :: SyntaxExpr Id -> PmExpr
+synExprToPmExpr :: SyntaxExpr GhcTc -> PmExpr
 synExprToPmExpr = hsExprToPmExpr . syn_expr  -- ignore the wrappers
 
 {-
index e1d44c1..2ef2db4 100644 (file)
@@ -312,6 +312,7 @@ Library
         HsImpExp
         HsLit
         PlaceHolder
+        HsExtension
         HsPat
         HsSyn
         HsTypes
index 2d2fede..a2a123c 100644 (file)
@@ -490,6 +490,7 @@ compiler_stage2_dll0_MODULES = \
        HsImpExp \
        HsLit \
        PlaceHolder \
+       HsExtension \
        PmExpr \
        HsPat \
        HsSyn \
index e64c4ea..5ded8bc 100644 (file)
@@ -6,6 +6,7 @@
 This module converts Template Haskell syntax into HsSyn
 -}
 
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module Convert( convertToHsExpr, convertToPat, convertToHsDecls,
@@ -46,20 +47,20 @@ import Language.Haskell.TH.Syntax as TH
 -------------------------------------------------------------------
 --              The external interface
 
-convertToHsDecls :: SrcSpan -> [TH.Dec] -> Either MsgDoc [LHsDecl RdrName]
+convertToHsDecls :: SrcSpan -> [TH.Dec] -> Either MsgDoc [LHsDecl GhcPs]
 convertToHsDecls loc ds = initCvt loc (fmap catMaybes (mapM cvt_dec ds))
   where
     cvt_dec d = wrapMsg "declaration" d (cvtDec d)
 
-convertToHsExpr :: SrcSpan -> TH.Exp -> Either MsgDoc (LHsExpr RdrName)
+convertToHsExpr :: SrcSpan -> TH.Exp -> Either MsgDoc (LHsExpr GhcPs)
 convertToHsExpr loc e
   = initCvt loc $ wrapMsg "expression" e $ cvtl e
 
-convertToPat :: SrcSpan -> TH.Pat -> Either MsgDoc (LPat RdrName)
+convertToPat :: SrcSpan -> TH.Pat -> Either MsgDoc (LPat GhcPs)
 convertToPat loc p
   = initCvt loc $ wrapMsg "pattern" p $ cvtPat p
 
-convertToHsType :: SrcSpan -> TH.Type -> Either MsgDoc (LHsType RdrName)
+convertToHsType :: SrcSpan -> TH.Type -> Either MsgDoc (LHsType GhcPs)
 convertToHsType loc t
   = initCvt loc $ wrapMsg "type" t $ cvtType t
 
@@ -133,10 +134,10 @@ wrapL (CvtM m) = CvtM (\loc -> case m loc of
                                Right (loc',v) -> Right (loc',L loc v))
 
 -------------------------------------------------------------------
-cvtDecs :: [TH.Dec] -> CvtM [LHsDecl RdrName]
+cvtDecs :: [TH.Dec] -> CvtM [LHsDecl GhcPs]
 cvtDecs = fmap catMaybes . mapM cvtDec
 
-cvtDec :: TH.Dec -> CvtM (Maybe (LHsDecl RdrName))
+cvtDec :: TH.Dec -> CvtM (Maybe (LHsDecl GhcPs))
 cvtDec (TH.ValD pat body ds)
   | TH.VarP s <- pat
   = do  { s' <- vNameL s
@@ -248,7 +249,7 @@ cvtDec (ClassD ctxt cl tvs fds decs)
                               -- no docs in TH ^^
         }
   where
-    cvt_at_def :: LTyFamInstDecl RdrName -> CvtM (LTyFamDefltEqn RdrName)
+    cvt_at_def :: LTyFamInstDecl GhcPs -> CvtM (LTyFamDefltEqn GhcPs)
     -- Very similar to what happens in RdrHsSyn.mkClassDecl
     cvt_at_def decl = case RdrHsSyn.mkATDefault decl of
                         Right def     -> return def
@@ -384,7 +385,7 @@ cvtDec (TH.PatSynSigD nm ty)
        ; returnJustL $ Hs.SigD $ PatSynSig [nm'] (mkLHsSigType ty') }
 
 ----------------
-cvtTySynEqn :: Located RdrName -> TySynEqn -> CvtM (LTyFamInstEqn RdrName)
+cvtTySynEqn :: Located RdrName -> TySynEqn -> CvtM (LTyFamInstEqn GhcPs)
 cvtTySynEqn tc (TySynEqn lhs rhs)
   = do  { lhs' <- mapM (wrap_apps <=< cvtType) lhs
         ; rhs' <- cvtType rhs
@@ -395,11 +396,11 @@ cvtTySynEqn tc (TySynEqn lhs rhs)
 
 ----------------
 cvt_ci_decs :: MsgDoc -> [TH.Dec]
-            -> CvtM (LHsBinds RdrName,
-                     [LSig RdrName],
-                     [LFamilyDecl RdrName],
-                     [LTyFamInstDecl RdrName],
-                     [LDataFamInstDecl RdrName])
+            -> CvtM (LHsBinds GhcPs,
+                     [LSig GhcPs],
+                     [LFamilyDecl GhcPs],
+                     [LTyFamInstDecl GhcPs],
+                     [LDataFamInstDecl GhcPs])
 -- Convert the declarations inside a class or instance decl
 -- ie signatures, bindings, and associated types
 cvt_ci_decs doc decs
@@ -416,9 +417,9 @@ cvt_ci_decs doc decs
 
 ----------------
 cvt_tycl_hdr :: TH.Cxt -> TH.Name -> [TH.TyVarBndr]
-             -> CvtM ( LHsContext RdrName
+             -> CvtM ( LHsContext GhcPs
                      , Located RdrName
-                     , LHsQTyVars RdrName)
+                     , LHsQTyVars GhcPs)
 cvt_tycl_hdr cxt tc tvs
   = do { cxt' <- cvtContext cxt
        ; tc'  <- tconNameL tc
@@ -427,9 +428,9 @@ cvt_tycl_hdr cxt tc tvs
        }
 
 cvt_tyinst_hdr :: TH.Cxt -> TH.Name -> [TH.Type]
-               -> CvtM ( LHsContext RdrName
+               -> CvtM ( LHsContext GhcPs
                        , Located RdrName
-                       , HsImplicitBndrs RdrName [LHsType RdrName])
+                       , HsImplicitBndrs GhcPs [LHsType GhcPs])
 cvt_tyinst_hdr cxt tc tys
   = do { cxt' <- cvtContext cxt
        ; tc'  <- tconNameL tc
@@ -439,9 +440,9 @@ cvt_tyinst_hdr cxt tc tys
 ----------------
 cvt_tyfam_head :: TypeFamilyHead
                -> CvtM ( Located RdrName
-                       , LHsQTyVars RdrName
-                       , Hs.LFamilyResultSig RdrName
-                       , Maybe (Hs.LInjectivityAnn RdrName))
+                       , LHsQTyVars GhcPs
+                       , Hs.LFamilyResultSig GhcPs
+                       , Maybe (Hs.LInjectivityAnn GhcPs))
 
 cvt_tyfam_head (TypeFamilyHead tc tyvars result injectivity)
   = do {(_, tc', tyvars') <- cvt_tycl_hdr [] tc tyvars
@@ -453,23 +454,24 @@ cvt_tyfam_head (TypeFamilyHead tc tyvars result injectivity)
 --              Partitioning declarations
 -------------------------------------------------------------------
 
-is_fam_decl :: LHsDecl RdrName -> Either (LFamilyDecl RdrName) (LHsDecl RdrName)
+is_fam_decl :: LHsDecl GhcPs -> Either (LFamilyDecl GhcPs) (LHsDecl GhcPs)
 is_fam_decl (L loc (TyClD (FamDecl { tcdFam = d }))) = Left (L loc d)
 is_fam_decl decl = Right decl
 
-is_tyfam_inst :: LHsDecl RdrName -> Either (LTyFamInstDecl RdrName) (LHsDecl RdrName)
+is_tyfam_inst :: LHsDecl GhcPs -> Either (LTyFamInstDecl GhcPs) (LHsDecl GhcPs)
 is_tyfam_inst (L loc (Hs.InstD (TyFamInstD { tfid_inst = d }))) = Left (L loc d)
 is_tyfam_inst decl                                              = Right decl
 
-is_datafam_inst :: LHsDecl RdrName -> Either (LDataFamInstDecl RdrName) (LHsDecl RdrName)
+is_datafam_inst :: LHsDecl GhcPs
+                -> Either (LDataFamInstDecl GhcPs) (LHsDecl GhcPs)
 is_datafam_inst (L loc (Hs.InstD (DataFamInstD { dfid_inst = d }))) = Left (L loc d)
 is_datafam_inst decl                                                = Right decl
 
-is_sig :: LHsDecl RdrName -> Either (LSig RdrName) (LHsDecl RdrName)
+is_sig :: LHsDecl GhcPs -> Either (LSig GhcPs) (LHsDecl GhcPs)
 is_sig (L loc (Hs.SigD sig)) = Left (L loc sig)
 is_sig decl                  = Right decl
 
-is_bind :: LHsDecl RdrName -> Either (LHsBind RdrName) (LHsDecl RdrName)
+is_bind :: LHsDecl GhcPs -> Either (LHsBind GhcPs) (LHsDecl GhcPs)
 is_bind (L loc (Hs.ValD bind)) = Left (L loc bind)
 is_bind decl                   = Right decl
 
@@ -482,7 +484,7 @@ mkBadDecMsg doc bads
 --      Data types
 ---------------------------------------------------
 
-cvtConstr :: TH.Con -> CvtM (LConDecl RdrName)
+cvtConstr :: TH.Con -> CvtM (LConDecl GhcPs)
 
 cvtConstr (NormalC c strtys)
   = do  { c'   <- cNameL c
@@ -550,7 +552,7 @@ cvtSrcStrictness NoSourceStrictness = NoSrcStrict
 cvtSrcStrictness SourceLazy         = SrcLazy
 cvtSrcStrictness SourceStrict       = SrcStrict
 
-cvt_arg :: (TH.Bang, TH.Type) -> CvtM (LHsType RdrName)
+cvt_arg :: (TH.Bang, TH.Type) -> CvtM (LHsType GhcPs)
 cvt_arg (Bang su ss, ty)
   = do { ty'' <- cvtType ty
        ; ty' <- wrap_apps ty''
@@ -558,7 +560,7 @@ cvt_arg (Bang su ss, ty)
        ; let ss' = cvtSrcStrictness ss
        ; returnL $ HsBangTy (HsSrcBang NoSourceText su' ss') ty' }
 
-cvt_id_arg :: (TH.Name, TH.Bang, TH.Type) -> CvtM (LConDeclField RdrName)
+cvt_id_arg :: (TH.Name, TH.Bang, TH.Type) -> CvtM (LConDeclField GhcPs)
 cvt_id_arg (i, str, ty)
   = do  { L li i' <- vNameL i
         ; ty' <- cvt_arg (str,ty)
@@ -568,7 +570,7 @@ cvt_id_arg (i, str, ty)
                           , cd_fld_type =  ty'
                           , cd_fld_doc = Nothing}) }
 
-cvtDerivs :: [TH.DerivClause] -> CvtM (HsDeriving RdrName)
+cvtDerivs :: [TH.DerivClause] -> CvtM (HsDeriving GhcPs)
 cvtDerivs cs = do { cs' <- mapM cvtDerivClause cs
                   ; returnL cs' }
 
@@ -582,7 +584,7 @@ cvt_fundep (FunDep xs ys) = do { xs' <- mapM tNameL xs
 --      Foreign declarations
 ------------------------------------------
 
-cvtForD :: Foreign -> CvtM (ForeignDecl RdrName)
+cvtForD :: Foreign -> CvtM (ForeignDecl GhcPs)
 cvtForD (ImportF callconv safety from nm ty)
   -- the prim and javascript calling conventions do not support headers
   -- and are inserted verbatim, analogous to mkImport in RdrHsSyn
@@ -635,7 +637,7 @@ cvt_conv TH.JavaScript = JavaScriptCallConv
 --              Pragmas
 ------------------------------------------
 
-cvtPragmaD :: Pragma -> CvtM (Maybe (LHsDecl RdrName))
+cvtPragmaD :: Pragma -> CvtM (Maybe (LHsDecl GhcPs))
 cvtPragmaD (InlineP nm inline rm phases)
   = do { nm' <- vNameL nm
        ; let dflt = dfltActivation inline
@@ -727,7 +729,7 @@ cvtPhases AllPhases       dflt = dflt
 cvtPhases (FromPhase i)   _    = ActiveAfter NoSourceText i
 cvtPhases (BeforePhase i) _    = ActiveBefore NoSourceText i
 
-cvtRuleBndr :: TH.RuleBndr -> CvtM (Hs.LRuleBndr RdrName)
+cvtRuleBndr :: TH.RuleBndr -> CvtM (Hs.LRuleBndr GhcPs)
 cvtRuleBndr (RuleVar n)
   = do { n' <- vNameL n
        ; return $ noLoc $ Hs.RuleBndr n' }
@@ -740,7 +742,7 @@ cvtRuleBndr (TypedRuleVar n ty)
 --              Declarations
 ---------------------------------------------------
 
-cvtLocalDecs :: MsgDoc -> [TH.Dec] -> CvtM (HsLocalBinds RdrName)
+cvtLocalDecs :: MsgDoc -> [TH.Dec] -> CvtM (HsLocalBinds GhcPs)
 cvtLocalDecs doc ds
   | null ds
   = return EmptyLocalBinds
@@ -752,7 +754,7 @@ cvtLocalDecs doc ds
        ; return (HsValBinds (ValBindsIn (listToBag binds) sigs)) }
 
 cvtClause :: HsMatchContext RdrName
-          -> TH.Clause -> CvtM (Hs.LMatch RdrName (LHsExpr RdrName))
+          -> TH.Clause -> CvtM (Hs.LMatch GhcPs (LHsExpr GhcPs))
 cvtClause ctxt (Clause ps body wheres)
   = do  { ps' <- cvtPats ps
         ; pps <- mapM wrap_conpat ps'
@@ -766,7 +768,7 @@ cvtClause ctxt (Clause ps body wheres)
 --              Expressions
 -------------------------------------------------------------------
 
-cvtl :: TH.Exp -> CvtM (LHsExpr RdrName)
+cvtl :: TH.Exp -> CvtM (LHsExpr GhcPs)
 cvtl e = wrapL (cvt e)
   where
     cvt (VarE s)        = do { s' <- vName s; return $ HsVar (noLoc s') }
@@ -875,14 +877,15 @@ and the above expression would be reassociated to
 which we don't want.
 -}
 
-cvtFld :: (RdrName -> t) -> (TH.Name, TH.Exp) -> CvtM (LHsRecField' t (LHsExpr RdrName))
+cvtFld :: (RdrName -> t) -> (TH.Name, TH.Exp)
+       -> CvtM (LHsRecField' t (LHsExpr GhcPs))
 cvtFld f (v,e)
   = do  { v' <- vNameL v; e' <- cvtl e
         ; return (noLoc $ HsRecField { hsRecFieldLbl = fmap f v'
                                      , hsRecFieldArg = e'
                                      , hsRecPun      = False}) }
 
-cvtDD :: Range -> CvtM (ArithSeqInfo RdrName)
+cvtDD :: Range -> CvtM (ArithSeqInfo GhcPs)
 cvtDD (FromR x)           = do { x' <- cvtl x; return $ From x' }
 cvtDD (FromThenR x y)     = do { x' <- cvtl x; y' <- cvtl y; return $ FromThen x' y' }
 cvtDD (FromToR x y)       = do { x' <- cvtl x; y' <- cvtl y; return $ FromTo x' y' }
@@ -940,7 +943,7 @@ the recursive calls to @cvtOpApp@.
 When we call @cvtOpApp@ from @cvtl@, the first argument will always be left-biased
 since we have already run @cvtl@ on it.
 -}
-cvtOpApp :: LHsExpr RdrName -> TH.Exp -> TH.Exp -> CvtM (HsExpr RdrName)
+cvtOpApp :: LHsExpr GhcPs -> TH.Exp -> TH.Exp -> CvtM (HsExpr GhcPs)
 cvtOpApp x op1 (UInfixE y op2 z)
   = do { l <- wrapL $ cvtOpApp x op1 y
        ; cvtOpApp l op2 z }
@@ -953,7 +956,7 @@ cvtOpApp x op y
 --      Do notation and statements
 -------------------------------------
 
-cvtHsDo :: HsStmtContext Name.Name -> [TH.Stmt] -> CvtM (HsExpr RdrName)
+cvtHsDo :: HsStmtContext Name.Name -> [TH.Stmt] -> CvtM (HsExpr GhcPs)
 cvtHsDo do_or_lc stmts
   | null stmts = failWith (text "Empty stmt list in do-block")
   | otherwise
@@ -970,10 +973,10 @@ cvtHsDo do_or_lc stmts
                          , nest 2 $ Outputable.ppr stmt
                          , text "(It should be an expression.)" ]
 
-cvtStmts :: [TH.Stmt] -> CvtM [Hs.LStmt RdrName (LHsExpr RdrName)]
+cvtStmts :: [TH.Stmt] -> CvtM [Hs.LStmt GhcPs (LHsExpr GhcPs)]
 cvtStmts = mapM cvtStmt
 
-cvtStmt :: TH.Stmt -> CvtM (Hs.LStmt RdrName (LHsExpr RdrName))
+cvtStmt :: TH.Stmt -> CvtM (Hs.LStmt GhcPs (LHsExpr GhcPs))
 cvtStmt (NoBindS e)    = do { e' <- cvtl e; returnL $ mkBodyStmt e' }
 cvtStmt (TH.BindS p e) = do { p' <- cvtPat p; e' <- cvtl e; returnL $ mkBindStmt p' e' }
 cvtStmt (TH.LetS ds)   = do { ds' <- cvtLocalDecs (text "a let binding") ds
@@ -983,7 +986,7 @@ cvtStmt (TH.ParS dss)  = do { dss' <- mapM cvt_one dss; returnL $ ParStmt dss' n
                          cvt_one ds = do { ds' <- cvtStmts ds; return (ParStmtBlock ds' undefined noSyntaxExpr) }
 
 cvtMatch :: HsMatchContext RdrName
-         -> TH.Match -> CvtM (Hs.LMatch RdrName (LHsExpr RdrName))
+         -> TH.Match -> CvtM (Hs.LMatch GhcPs (LHsExpr GhcPs))
 cvtMatch ctxt (TH.Match p body decs)
   = do  { p' <- cvtPat p
         ; lp <- case ctxt of
@@ -994,18 +997,18 @@ cvtMatch ctxt (TH.Match p body decs)
         ; returnL $ Hs.Match ctxt [lp] Nothing
                              (GRHSs g' (noLoc decs')) }
 
-cvtGuard :: TH.Body -> CvtM [LGRHS RdrName (LHsExpr RdrName)]
+cvtGuard :: TH.Body -> CvtM [LGRHS GhcPs (LHsExpr GhcPs)]
 cvtGuard (GuardedB pairs) = mapM cvtpair pairs
 cvtGuard (NormalB e)      = do { e' <- cvtl e; g' <- returnL $ GRHS [] e'; return [g'] }
 
-cvtpair :: (TH.Guard, TH.Exp) -> CvtM (LGRHS RdrName (LHsExpr RdrName))
+cvtpair :: (TH.Guard, TH.Exp) -> CvtM (LGRHS GhcPs (LHsExpr GhcPs))
 cvtpair (NormalG ge,rhs) = do { ge' <- cvtl ge; rhs' <- cvtl rhs
                               ; g' <- returnL $ mkBodyStmt ge'
                               ; returnL $ GRHS [g'] rhs' }
 cvtpair (PatG gs,rhs)    = do { gs' <- cvtStmts gs; rhs' <- cvtl rhs
                               ; returnL $ GRHS gs' rhs' }
 
-cvtOverLit :: Lit -> CvtM (HsOverLit RdrName)
+cvtOverLit :: Lit -> CvtM (HsOverLit GhcPs)
 cvtOverLit (IntegerL i)
   = do { force i; return $ mkHsIntegral   (mkIntegralLit i)   placeHolderType}
 cvtOverLit (RationalL r)
@@ -1040,11 +1043,13 @@ allCharLs xs
     go cs (LitE (CharL c) : ys) = go (c:cs) ys
     go _  _                     = Nothing
 
-cvtLit :: Lit -> CvtM HsLit
+cvtLit :: Lit -> CvtM (HsLit GhcPs)
 cvtLit (IntPrimL i)    = do { force i; return $ HsIntPrim NoSourceText i }
 cvtLit (WordPrimL w)   = do { force w; return $ HsWordPrim NoSourceText w }
-cvtLit (FloatPrimL f)  = do { force f; return $ HsFloatPrim (mkFractionalLit f) }
-cvtLit (DoublePrimL f) = do { force f; return $ HsDoublePrim (mkFractionalLit f) }
+cvtLit (FloatPrimL f)
+  = do { force f; return $ HsFloatPrim def (mkFractionalLit f) }
+cvtLit (DoublePrimL f)
+  = do { force f; return $ HsDoublePrim def (mkFractionalLit f) }
 cvtLit (CharL c)       = do { force c; return $ HsChar NoSourceText c }
 cvtLit (CharPrimL c)   = do { force c; return $ HsCharPrim NoSourceText c }
 cvtLit (StringL s)     = do { let { s' = mkFastString s }
@@ -1061,13 +1066,13 @@ cvtLit _ = panic "Convert.cvtLit: Unexpected literal"
 quotedSourceText :: String -> SourceText
 quotedSourceText s = SourceText $ "\"" ++ s ++ "\""
 
-cvtPats :: [TH.Pat] -> CvtM [Hs.LPat RdrName]
+cvtPats :: [TH.Pat] -> CvtM [Hs.LPat GhcPs]
 cvtPats pats = mapM cvtPat pats
 
-cvtPat :: TH.Pat -> CvtM (Hs.LPat RdrName)
+cvtPat :: TH.Pat -> CvtM (Hs.LPat GhcPs)
 cvtPat pat = wrapL (cvtp pat)
 
-cvtp :: TH.Pat -> CvtM (Hs.Pat RdrName)
+cvtp :: TH.Pat -> CvtM (Hs.Pat GhcPs)
 cvtp (TH.LitP l)
   | overloadedLit l    = do { l' <- cvtOverLit l
                             ; return (mkNPat (noLoc l') Nothing) }
@@ -1108,7 +1113,7 @@ cvtp (SigP p t)        = do { p' <- cvtPat p; t' <- cvtType t
 cvtp (ViewP e p)       = do { e' <- cvtl e; p' <- cvtPat p
                             ; return $ ViewPat e' p' placeHolderType }
 
-cvtPatFld :: (TH.Name, TH.Pat) -> CvtM (LHsRecField RdrName (LPat RdrName))
+cvtPatFld :: (TH.Name, TH.Pat) -> CvtM (LHsRecField GhcPs (LPat GhcPs))
 cvtPatFld (s,p)
   = do  { L ls s' <- vNameL s; p' <- cvtPat p
         ; return (noLoc $ HsRecField { hsRecFieldLbl
@@ -1116,7 +1121,7 @@ cvtPatFld (s,p)
                                      , hsRecFieldArg = p'
                                      , hsRecPun      = False}) }
 
-wrap_conpat :: Hs.LPat RdrName -> CvtM (Hs.LPat RdrName)
+wrap_conpat :: Hs.LPat GhcPs -> CvtM (Hs.LPat GhcPs)
 wrap_conpat p@(L _ (ConPatIn _ (InfixCon{})))   = returnL $ ParPat p
 wrap_conpat p@(L _ (ConPatIn _ (PrefixCon []))) = return p
 wrap_conpat p@(L _ (ConPatIn _ (PrefixCon _)))  = returnL $ ParPat p
@@ -1127,7 +1132,7 @@ The produced tree of infix patterns will be left-biased, provided @x@ is.
 
 See the @cvtOpApp@ documentation for how this function works.
 -}
-cvtOpAppP :: Hs.LPat RdrName -> TH.Name -> TH.Pat -> CvtM (Hs.Pat RdrName)
+cvtOpAppP :: Hs.LPat GhcPs -> TH.Name -> TH.Pat -> CvtM (Hs.Pat GhcPs)
 cvtOpAppP x op1 (UInfixP y op2 z)
   = do { l <- wrapL $ cvtOpAppP x op1 y
        ; cvtOpAppP l op2 z }
@@ -1139,10 +1144,10 @@ cvtOpAppP x op y
 -----------------------------------------------------------
 --      Types and type variables
 
-cvtTvs :: [TH.TyVarBndr] -> CvtM (LHsQTyVars RdrName)
+cvtTvs :: [TH.TyVarBndr] -> CvtM (LHsQTyVars GhcPs)
 cvtTvs tvs = do { tvs' <- mapM cvt_tv tvs; return (mkHsQTvs tvs') }
 
-cvt_tv :: TH.TyVarBndr -> CvtM (LHsTyVarBndr RdrName)
+cvt_tv :: TH.TyVarBndr -> CvtM (LHsTyVarBndr GhcPs)
 cvt_tv (TH.PlainTV nm)
   = do { nm' <- tNameL nm
        ; returnL $ UserTyVar nm' }
@@ -1157,14 +1162,14 @@ cvtRole TH.RepresentationalR = Just Coercion.Representational
 cvtRole TH.PhantomR          = Just Coercion.Phantom
 cvtRole TH.InferR            = Nothing
 
-cvtContext :: TH.Cxt -> CvtM (LHsContext RdrName)
+cvtContext :: TH.Cxt -> CvtM (LHsContext GhcPs)
 cvtContext tys = do { preds' <- mapM cvtPred tys; returnL preds' }
 
-cvtPred :: TH.Pred -> CvtM (LHsType RdrName)
+cvtPred :: TH.Pred -> CvtM (LHsType GhcPs)
 cvtPred = cvtType
 
 cvtDerivClause :: TH.DerivClause
-               -> CvtM (LHsDerivingClause RdrName)
+               -> CvtM (LHsDerivingClause GhcPs)
 cvtDerivClause (TH.DerivClause ds ctxt)
   = do { ctxt'@(L loc _) <- fmap (map mkLHsSigType) <$> cvtContext ctxt
        ; let ds' = fmap (L loc . cvtDerivStrategy) ds
@@ -1175,10 +1180,10 @@ cvtDerivStrategy TH.StockStrategy    = Hs.StockStrategy
 cvtDerivStrategy TH.AnyclassStrategy = Hs.AnyclassStrategy
 cvtDerivStrategy TH.NewtypeStrategy  = Hs.NewtypeStrategy
 
-cvtType :: TH.Type -> CvtM (LHsType RdrName)
+cvtType :: TH.Type -> CvtM (LHsType GhcPs)
 cvtType = cvtTypeKind "type"
 
-cvtTypeKind :: String -> TH.Type -> CvtM (LHsType RdrName)
+cvtTypeKind :: String -> TH.Type -> CvtM (LHsType GhcPs)
 cvtTypeKind ty_str ty
   = do { (head_ty, tys') <- split_ty_app ty
        ; case head_ty of
@@ -1313,7 +1318,7 @@ cvtTypeKind ty_str ty
     }
 
 -- | Constructs an application of a type to arguments passed in a list.
-mk_apps :: HsType RdrName -> [LHsType RdrName] -> CvtM (LHsType RdrName)
+mk_apps :: HsType GhcPs -> [LHsType GhcPs] -> CvtM (LHsType GhcPs)
 mk_apps head_ty []       = returnL head_ty
 mk_apps head_ty (ty:tys) =
   do { head_ty' <- returnL head_ty
@@ -1323,18 +1328,18 @@ mk_apps head_ty (ty:tys) =
     add_parens t@(L _ HsAppTy{}) = returnL (HsParTy t)
     add_parens t                 = return t
 
-wrap_apps  :: LHsType RdrName -> CvtM (LHsType RdrName)
+wrap_apps  :: LHsType GhcPs -> CvtM (LHsType GhcPs)
 wrap_apps t@(L _ HsAppTy {}) = returnL (HsParTy t)
 wrap_apps t                  = return t
 
 -- | Constructs an arrow type with a specified return type
-mk_arr_apps :: [LHsType RdrName] -> HsType RdrName -> CvtM (LHsType RdrName)
+mk_arr_apps :: [LHsType GhcPs] -> HsType GhcPs -> CvtM (LHsType GhcPs)
 mk_arr_apps tys return_ty = foldrM go return_ty tys >>= returnL
-    where go :: LHsType RdrName -> HsType RdrName -> CvtM (HsType RdrName)
+    where go :: LHsType GhcPs -> HsType GhcPs -> CvtM (HsType GhcPs)
           go arg ret_ty = do { ret_ty_l <- returnL ret_ty
                              ; return (HsFunTy arg ret_ty_l) }
 
-split_ty_app :: TH.Type -> CvtM (TH.Type, [LHsType RdrName])
+split_ty_app :: TH.Type -> CvtM (TH.Type, [LHsType GhcPs])
 split_ty_app ty = go ty []
   where
     go (AppT f a) as' = do { a' <- cvtType a; go f (a':as') }
@@ -1347,7 +1352,7 @@ cvtTyLit (TH.StrTyLit s) = HsStrTy NoSourceText (fsLit s)
 {- | @cvtOpAppT x op y@ takes converted arguments and flattens any HsAppsTy
    structure in them.
 -}
-cvtOpAppT :: LHsType RdrName -> RdrName -> LHsType RdrName -> LHsType RdrName
+cvtOpAppT :: LHsType GhcPs -> RdrName -> LHsType GhcPs -> LHsType GhcPs
 cvtOpAppT t1@(L loc1 _) op t2@(L loc2 _)
   = L (combineSrcSpans loc1 loc2) $
     HsAppsTy (t1' ++ [noLoc $ HsAppInfix (noLoc op)] ++ t2')
@@ -1362,21 +1367,21 @@ cvtOpAppT t1@(L loc1 _) op t2@(L loc2 _)
         | otherwise
         = [noLoc $ HsAppPrefix t2]
 
-cvtKind :: TH.Kind -> CvtM (LHsKind RdrName)
+cvtKind :: TH.Kind -> CvtM (LHsKind GhcPs)
 cvtKind = cvtTypeKind "kind"
 
 -- | Convert Maybe Kind to a type family result signature. Used with data
 -- families where naming of the result is not possible (thus only kind or no
 -- signature is possible).
 cvtMaybeKindToFamilyResultSig :: Maybe TH.Kind
-                              -> CvtM (LFamilyResultSig RdrName)
+                              -> CvtM (LFamilyResultSig GhcPs)
 cvtMaybeKindToFamilyResultSig Nothing   = returnL Hs.NoSig
 cvtMaybeKindToFamilyResultSig (Just ki) = do { ki' <- cvtKind ki
                                              ; returnL (Hs.KindSig ki') }
 
 -- | Convert type family result signature. Used with both open and closed type
 -- families.
-cvtFamilyResultSig :: TH.FamilyResultSig -> CvtM (Hs.LFamilyResultSig RdrName)
+cvtFamilyResultSig :: TH.FamilyResultSig -> CvtM (Hs.LFamilyResultSig GhcPs)
 cvtFamilyResultSig TH.NoSig           = returnL Hs.NoSig
 cvtFamilyResultSig (TH.KindSig ki)    = do { ki' <- cvtKind ki
                                            ; returnL (Hs.KindSig ki') }
@@ -1385,13 +1390,13 @@ cvtFamilyResultSig (TH.TyVarSig bndr) = do { tv <- cvt_tv bndr
 
 -- | Convert injectivity annotation of a type family.
 cvtInjectivityAnnotation :: TH.InjectivityAnn
-                         -> CvtM (Hs.LInjectivityAnn RdrName)
+                         -> CvtM (Hs.LInjectivityAnn GhcPs)
 cvtInjectivityAnnotation (TH.InjectivityAnn annLHS annRHS)
   = do { annLHS' <- tNameL annLHS
        ; annRHS' <- mapM tNameL annRHS
        ; returnL (Hs.InjectivityAnn annLHS' annRHS') }
 
-cvtPatSynSigTy :: TH.Type -> CvtM (LHsType RdrName)
+cvtPatSynSigTy :: TH.Type -> CvtM (LHsType GhcPs)
 -- pattern synonym types are of peculiar shapes, which is why we treat
 -- them separately from regular types;
 -- see Note [Pattern synonym type signatures and Template Haskell]
index b39e25a..b760cb3 100644 (file)
@@ -22,13 +22,12 @@ import {-# SOURCE #-} HsExpr ( pprExpr, LHsExpr,
                                GRHSs, pprPatBind )
 import {-# SOURCE #-} HsPat  ( LPat )
 
-import PlaceHolder ( PostTc,PostRn,DataId,OutputableBndrId )
+import HsExtension
 import HsTypes
 import PprCore ()
 import CoreSyn
 import TcEvidence
 import Type
-import Name
 import NameSet
 import BasicTypes
 import Outputable
@@ -87,8 +86,7 @@ data HsLocalBindsLR idL idR
 
 type LHsLocalBindsLR idL idR = Located (HsLocalBindsLR idL idR)
 
-deriving instance (DataId idL, DataId idR)
-  => Data (HsLocalBindsLR idL idR)
+deriving instance (DataId idL, DataId idR) => Data (HsLocalBindsLR idL idR)
 
 -- | Haskell Value Bindings
 type HsValBinds id = HsValBindsLR id id
@@ -112,10 +110,9 @@ data HsValBindsLR idL idR
     -- later bindings in the list may depend on earlier ones.
   | ValBindsOut
         [(RecFlag, LHsBinds idL)]
-        [LSig Name]
+        [LSig GhcRn] -- AZ: how to do this?
 
-deriving instance (DataId idL, DataId idR)
-  => Data (HsValBindsLR idL idR)
+deriving instance (DataId idL, DataId idR) => Data (HsValBindsLR idL idR)
 
 -- | Located Haskell Binding
 type LHsBind  id = LHsBindLR  id id
@@ -158,7 +155,7 @@ data HsBindLR idL idR
     -- For details on above see note [Api annotations] in ApiAnnotation
     FunBind {
 
-        fun_id :: Located idL, -- Note [fun_id in Match] in HsExpr
+        fun_id :: Located (IdP idL), -- Note [fun_id in Match] in HsExpr
 
         fun_matches :: MatchGroup idR (LHsExpr idR),  -- ^ The payload
 
@@ -182,7 +179,7 @@ data HsBindLR idL idR
                                 -- See Note [Bind free vars]
 
 
-        fun_tick :: [Tickish Id]  -- ^ Ticks to put on the rhs, if any
+        fun_tick :: [Tickish Id] -- ^ Ticks to put on the rhs, if any
     }
 
   -- | Pattern Binding
@@ -210,7 +207,7 @@ data HsBindLR idL idR
   -- Dictionary binding and suchlike.
   -- All VarBinds are introduced by the type checker
   | VarBind {
-        var_id     :: idL,
+        var_id     :: IdP idL,
         var_rhs    :: LHsExpr idR,   -- ^ Located only for consistency
         var_inline :: Bool           -- ^ True <=> inline this binding regardless
                                      -- (used for implication constraints only)
@@ -242,7 +239,7 @@ data HsBindLR idL idR
         abs_tvs     :: [TyVar],
         abs_ev_vars :: [EvVar],
 
-        abs_sig_export :: idL,  -- like abe_poly
+        abs_sig_export :: IdP idL,  -- like abe_poly
         abs_sig_prags  :: TcSpecPrags,
 
         abs_sig_ev_bind :: TcEvBinds,  -- no list needed here
@@ -259,8 +256,7 @@ data HsBindLR idL idR
 
         -- For details on above see note [Api annotations] in ApiAnnotation
 
-deriving instance (DataId idL, DataId idR)
-  => Data (HsBindLR idL idR)
+deriving instance (DataId idL, DataId idR) => Data (HsBindLR idL idR)
 
         -- Consider (AbsBinds tvs ds [(ftvs, poly_f, mono_f) binds]
         --
@@ -275,13 +271,14 @@ deriving instance (DataId idL, DataId idR)
         -- See Note [AbsBinds]
 
 -- | Abtraction Bindings Export
-data ABExport id
-  = ABE { abe_poly      :: id    -- ^ Any INLINE pragmas is attached to this Id
-        , abe_mono      :: id
+data ABExport p
+  = ABE { abe_poly      :: IdP p -- ^ Any INLINE pragmas is attached to this Id
+        , abe_mono      :: IdP p
         , abe_wrap      :: HsWrapper    -- ^ See Note [ABExport wrapper]
              -- Shape: (forall abs_tvs. abs_ev_vars => abe_mono) ~ abe_poly
         , abe_prags     :: TcSpecPrags  -- ^ SPECIALISE pragmas
-  } deriving Data
+  }
+deriving instance (DataId p) => Data (ABExport p)
 
 -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnPattern',
 --             'ApiAnnotation.AnnEqual','ApiAnnotation.AnnLarrow'
@@ -292,14 +289,14 @@ data ABExport id
 
 -- | Pattern Synonym binding
 data PatSynBind idL idR
-  = PSB { psb_id   :: Located idL,             -- ^ Name of the pattern synonym
+  = PSB { psb_id   :: Located (IdP idL),       -- ^ Name of the pattern synonym
           psb_fvs  :: PostRn idR NameSet,      -- ^ See Note [Bind free vars]
-          psb_args :: HsPatSynDetails (Located idR), -- ^ Formal parameter names
-          psb_def  :: LPat idR,                      -- ^ Right-hand side
-          psb_dir  :: HsPatSynDir idR                -- ^ Directionality
+          psb_args :: HsPatSynDetails (Located (IdP idR)),
+                                               -- ^ Formal parameter names
+          psb_def  :: LPat idR,                -- ^ Right-hand side
+          psb_dir  :: HsPatSynDir idR          -- ^ Directionality
   }
-deriving instance (DataId idL, DataId idR)
-  => Data (PatSynBind idL idR)
+deriving instance (DataId idL, DataId idR) => Data (PatSynBind idL idR)
 
 {-
 Note [AbsBinds]
@@ -442,13 +439,15 @@ Specifically,
     it's just an error thunk
 -}
 
-instance (OutputableBndrId idL, OutputableBndrId idR)
+instance (SourceTextX idL, SourceTextX idR,
+          OutputableBndrId idL, OutputableBndrId idR)
         => Outputable (HsLocalBindsLR idL idR) where
   ppr (HsValBinds bs) = ppr bs
   ppr (HsIPBinds bs)  = ppr bs
   ppr EmptyLocalBinds = empty
 
-instance (OutputableBndrId idL, OutputableBndrId idR)
+instance (SourceTextX idL, SourceTextX idR,
+          OutputableBndrId idL, OutputableBndrId idR)
         => Outputable (HsValBindsLR idL idR) where
   ppr (ValBindsIn binds sigs)
    = pprDeclList (pprLHsBindsForUser binds sigs)
@@ -464,14 +463,16 @@ instance (OutputableBndrId idL, OutputableBndrId idR)
      pp_rec Recursive    = text "rec"
      pp_rec NonRecursive = text "nonrec"
 
-pprLHsBinds :: (OutputableBndrId idL, OutputableBndrId idR)
+pprLHsBinds :: (SourceTextX idL, SourceTextX idR,
+                OutputableBndrId idL, OutputableBndrId idR)
             => LHsBindsLR idL idR -> SDoc
 pprLHsBinds binds
   | isEmptyLHsBinds binds = empty
   | otherwise = pprDeclList (map ppr (bagToList binds))
 
-pprLHsBindsForUser :: (OutputableBndrId idL, OutputableBndrId idR,
-                       OutputableBndrId id2)
+pprLHsBindsForUser :: (SourceTextX idL, SourceTextX idR,
+                       OutputableBndrId idL, OutputableBndrId idR,
+                       SourceTextX id2, OutputableBndrId id2)
                    => LHsBindsLR idL idR -> [LSig id2] -> [SDoc]
 --  pprLHsBindsForUser is different to pprLHsBinds because
 --  a) No braces: 'let' and 'where' include a list of HsBindGroups
@@ -562,11 +563,13 @@ So the desugarer tries to do a better job:
                                       in (fm,gm)
 -}
 
-instance (OutputableBndrId idL, OutputableBndrId idR)
+instance (SourceTextX idL, SourceTextX idR,
+          OutputableBndrId idL, OutputableBndrId idR)
          => Outputable (HsBindLR idL idR) where
     ppr mbind = ppr_monobind mbind
 
-ppr_monobind :: (OutputableBndrId idL, OutputableBndrId idR)
+ppr_monobind :: (SourceTextX idL, SourceTextX idR,
+                 OutputableBndrId idL, OutputableBndrId idR)
              => HsBindLR idL idR -> SDoc
 
 ppr_monobind (PatBind { pat_lhs = pat, pat_rhs = grhss })
@@ -616,13 +619,14 @@ ppr_monobind (AbsBindsSig { abs_tvs         = tyvars
     else
       ppr bind
 
-instance (OutputableBndr id) => Outputable (ABExport id) where
+instance (OutputableBndrId p) => Outputable (ABExport p) where
   ppr (ABE { abe_wrap = wrap, abe_poly = gbl, abe_mono = lcl, abe_prags = prags })
     = vcat [ ppr gbl <+> text "<=" <+> ppr lcl
            , nest 2 (pprTcSpecPrags prags)
            , nest 2 (text "wrap:" <+> ppr wrap)]
 
-instance (OutputableBndr idL, OutputableBndrId idR)
+instance (SourceTextX idR,
+          OutputableBndrId idL, OutputableBndrId idR)
           => Outputable (PatSynBind idL idR) where
   ppr (PSB{ psb_id = (L _ psyn), psb_args = details, psb_def = pat,
             psb_dir = dir })
@@ -691,14 +695,14 @@ type LIPBind id = Located (IPBind id)
 
 -- For details on above see note [Api annotations] in ApiAnnotation
 data IPBind id
-  = IPBind (Either (Located HsIPName) id) (LHsExpr id)
+  = IPBind (Either (Located HsIPName) (IdP id)) (LHsExpr id)
 deriving instance (DataId name) => Data (IPBind name)
 
-instance (OutputableBndrId id ) => Outputable (HsIPBinds id) where
+instance (SourceTextX p, OutputableBndrId p) => Outputable (HsIPBinds p) where
   ppr (IPBinds bs ds) = pprDeeperList vcat (map ppr bs)
                         $$ ifPprDebug (ppr ds)
 
-instance (OutputableBndrId id ) => Outputable (IPBind id) where
+instance (SourceTextX p, OutputableBndrId p ) => Outputable (IPBind p) where
   ppr (IPBind lr rhs) = name <+> equals <+> pprExpr (unLoc rhs)
     where name = case lr of
                    Left (L _ ip) -> pprBndr LetBind ip
@@ -718,10 +722,10 @@ serves for both.
 -}
 
 -- | Located Signature
-type LSig name = Located (Sig name)
+type LSig pass = Located (Sig pass)
 
 -- | Signatures and pragmas
-data Sig name
+data Sig pass
   =   -- | An ordinary type signature
       --
       -- > f :: Num a => a -> a
@@ -739,8 +743,8 @@ data Sig name
 
       -- For details on above see note [Api annotations] in ApiAnnotation
     TypeSig
-       [Located name]        -- LHS of the signature; e.g.  f,g,h :: blah
-       (LHsSigWcType name)   -- RHS of the signature; can have wildcards
+       [Located (IdP pass)]  -- LHS of the signature; e.g.  f,g,h :: blah
+       (LHsSigWcType pass)   -- RHS of the signature; can have wildcards
 
       -- | A pattern synonym type signature
       --
@@ -751,7 +755,7 @@ data Sig name
       --           'ApiAnnotation.AnnDot','ApiAnnotation.AnnDarrow'
 
       -- For details on above see note [Api annotations] in ApiAnnotation
-  | PatSynSig [Located name] (LHsSigType name)
+  | PatSynSig [Located (IdP pass)] (LHsSigType pass)
       -- P :: forall a b. Req => Prov => ty
 
       -- | A signature for a class method
@@ -764,7 +768,7 @@ data Sig name
       --
       --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDefault',
       --           'ApiAnnotation.AnnDcolon'
-  | ClassOpSig Bool [Located name] (LHsSigType name)
+  | ClassOpSig Bool [Located (IdP pass)] (LHsSigType pass)
 
         -- | A type signature in generated code, notably the code
         -- generated for record selectors.  We simply record
@@ -782,7 +786,7 @@ data Sig name
         --           'ApiAnnotation.AnnVal'
 
         -- For details on above see note [Api annotations] in ApiAnnotation
-  | FixSig (FixitySig name)
+  | FixSig (FixitySig pass)
 
         -- | An inline pragma
         --
@@ -795,8 +799,8 @@ data Sig name
         --       'ApiAnnotation.AnnClose'
 
         -- For details on above see note [Api annotations] in ApiAnnotation
-  | InlineSig   (Located name)  -- Function name
-                InlinePragma    -- Never defaultInlinePragma
+  | InlineSig   (Located (IdP pass)) -- Function name
+                InlinePragma         -- Never defaultInlinePragma
 
         -- | A specialisation pragma
         --
@@ -810,8 +814,8 @@ data Sig name
         --      'ApiAnnotation.AnnDcolon'
 
         -- For details on above see note [Api annotations] in ApiAnnotation
-  | SpecSig     (Located name)     -- Specialise a function or datatype  ...
-                [LHsSigType name]  -- ... to these types
+  | SpecSig     (Located (IdP pass)) -- Specialise a function or datatype  ...
+                [LHsSigType pass]  -- ... to these types
                 InlinePragma       -- The pragma on SPECIALISE_INLINE form.
                                    -- If it's just defaultInlinePragma, then we said
                                    --    SPECIALISE, not SPECIALISE_INLINE
@@ -827,7 +831,7 @@ data Sig name
         --      'ApiAnnotation.AnnInstance','ApiAnnotation.AnnClose'
 
         -- For details on above see note [Api annotations] in ApiAnnotation
-  | SpecInstSig SourceText (LHsSigType name)
+  | SpecInstSig SourceText (LHsSigType pass)
                   -- Note [Pragma source text] in BasicTypes
 
         -- | A minimal complete definition pragma
@@ -839,7 +843,7 @@ data Sig name
         --      'ApiAnnotation.AnnClose'
 
         -- For details on above see note [Api annotations] in ApiAnnotation
-  | MinimalSig SourceText (LBooleanFormula (Located name))
+  | MinimalSig SourceText (LBooleanFormula (Located (IdP pass)))
                -- Note [Pragma source text] in BasicTypes
 
         -- | A "set cost centre" pragma for declarations
@@ -851,7 +855,7 @@ data Sig name
         -- > {-# SCC funName "cost_centre_name" #-}
 
   | SCCFunSig  SourceText      -- Note [Pragma source text] in BasicTypes
-               (Located name)  -- Function name
+               (Located (IdP pass))  -- Function name
                (Maybe (Located StringLiteral))
        -- | A complete match pragma
        --
@@ -860,16 +864,18 @@ data Sig name
        -- Used to inform the pattern match checker about additional
        -- complete matchings which, for example, arise from pattern
        -- synonym definitions.
-  | CompleteMatchSig SourceText (Located [Located name]) (Maybe (Located name))
+  | CompleteMatchSig SourceText
+                     (Located [Located (IdP pass)])
+                     (Maybe (Located (IdP pass)))
 
-deriving instance (DataId name) => Data (Sig name)
+deriving instance (DataId pass) => Data (Sig pass)
 
 -- | Located Fixity Signature
-type LFixitySig name = Located (FixitySig name)
+type LFixitySig pass = Located (FixitySig pass)
 
 -- | Fixity Signature
-data FixitySig name = FixitySig [Located name] Fixity
-  deriving Data
+data FixitySig pass = FixitySig [Located (IdP pass)] Fixity
+deriving instance (DataId pass) => Data (FixitySig pass)
 
 -- | Type checker Specialisation Pragmas
 --
@@ -969,10 +975,11 @@ signatures. Since some of the signatures contain a list of names, testing for
 equality is not enough -- we have to check if they overlap.
 -}
 
-instance (OutputableBndrId name ) => Outputable (Sig name) where
+instance (SourceTextX pass, OutputableBndrId pass)
+       => Outputable (Sig pass) where
     ppr sig = ppr_sig sig
 
-ppr_sig :: (OutputableBndrId name ) => Sig name -> SDoc
+ppr_sig :: (SourceTextX pass, OutputableBndrId pass ) => Sig pass -> SDoc
 ppr_sig (TypeSig vars ty)    = pprVarSig (map unLoc vars) (ppr ty)
 ppr_sig (ClassOpSig is_deflt vars ty)
   | is_deflt                 = text "default" <+> pprVarSig (map unLoc vars) (ppr ty)
@@ -1004,7 +1011,7 @@ ppr_sig (CompleteMatchSig src cs mty)
   where
     opt_sig = maybe empty ((\t -> dcolon <+> ppr t) . unLoc) mty
 
-instance OutputableBndr name => Outputable (FixitySig name) where
+instance OutputableBndrId pass => Outputable (FixitySig pass) where
   ppr (FixitySig names fixity) = sep [ppr fixity, pprops]
     where
       pprops = hsep $ punctuate comma (map (pprInfixOcc . unLoc) names)
index 7fcc3b8..8b7d9c6 100644 (file)
@@ -98,7 +98,8 @@ import Name
 import BasicTypes
 import Coercion
 import ForeignCall
-import PlaceHolder ( PostTc,PostRn,PlaceHolder(..),DataId, OutputableBndrId )
+import PlaceHolder ( PlaceHolder(..) )
+import HsExtension
 import NameSet
 
 -- others:
@@ -251,7 +252,8 @@ appendGroups
         hs_vects  = vects1 ++ vects2,
         hs_docs   = docs1  ++ docs2 }
 
-instance (OutputableBndrId name) => Outputable (HsDecl name) where
+instance (SourceTextX pass, OutputableBndrId pass)
+       => Outputable (HsDecl pass) where
     ppr (TyClD dcl)             = ppr dcl
     ppr (ValD binds)            = ppr binds
     ppr (DefD def)              = ppr def
@@ -267,7 +269,8 @@ instance (OutputableBndrId name) => Outputable (HsDecl name) where
     ppr (DocD doc)              = ppr doc
     ppr (RoleAnnotD ra)         = ppr ra
 
-instance (OutputableBndrId name) => Outputable (HsGroup name) where
+instance (SourceTextX pass, OutputableBndrId pass)
+      => Outputable (HsGroup pass) where
     ppr (HsGroup { hs_valds  = val_decls,
                    hs_tyclds = tycl_decls,
                    hs_derivds = deriv_decls,
@@ -302,7 +305,7 @@ instance (OutputableBndrId name) => Outputable (HsGroup name) where
           vcat_mb gap (Just d  : ds) = gap $$ d $$ vcat_mb blankLine ds
 
 -- | Located Splice Declaration
-type LSpliceDecl name = Located (SpliceDecl name)
+type LSpliceDecl pass = Located (SpliceDecl pass)
 
 -- | Splice Declaration
 data SpliceDecl id
@@ -311,7 +314,8 @@ data SpliceDecl id
         SpliceExplicitFlag
 deriving instance (DataId id) => Data (SpliceDecl id)
 
-instance (OutputableBndrId name) => Outputable (SpliceDecl name) where
+instance (SourceTextX pass, OutputableBndrId pass)
+       => Outputable (SpliceDecl pass) where
    ppr (SpliceDecl (L _ e) f) = pprSpliceDecl e f
 
 {-
@@ -454,10 +458,10 @@ Interface file code:
 -}
 
 -- | Located Declaration of a Type or Class
-type LTyClDecl name = Located (TyClDecl name)
+type LTyClDecl pass = Located (TyClDecl pass)
 
 -- | A type or class declaration.
-data TyClDecl name
+data TyClDecl pass
   = -- | @type/data family T :: *->*@
     --
     --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType',
@@ -469,7 +473,7 @@ data TyClDecl name
     --             'ApiAnnotation.AnnVbar'
 
     -- For details on above see note [Api annotations] in ApiAnnotation
-    FamDecl { tcdFam :: FamilyDecl name }
+    FamDecl { tcdFam :: FamilyDecl pass }
 
   | -- | @type@ declaration
     --
@@ -477,12 +481,13 @@ data TyClDecl name
     --             'ApiAnnotation.AnnEqual',
 
     -- For details on above see note [Api annotations] in ApiAnnotation
-    SynDecl { tcdLName  :: Located name           -- ^ Type constructor
-            , tcdTyVars :: LHsQTyVars name        -- ^ Type variables; for an associated type
-                                                  --   these include outer binders
+    SynDecl { tcdLName  :: Located (IdP pass)     -- ^ Type constructor
+            , tcdTyVars :: LHsQTyVars pass        -- ^ Type variables; for an
+                                                  -- associated type these
+                                                  -- include outer binders
             , tcdFixity :: LexicalFixity    -- ^ Fixity used in the declaration
-            , tcdRhs    :: LHsType name           -- ^ RHS of type declaration
-            , tcdFVs    :: PostRn name NameSet }
+            , tcdRhs    :: LHsType pass           -- ^ RHS of type declaration
+            , tcdFVs    :: PostRn pass NameSet }
 
   | -- | @data@ declaration
     --
@@ -493,31 +498,33 @@ data TyClDecl name
     --              'ApiAnnotation.AnnWhere',
 
     -- For details on above see note [Api annotations] in ApiAnnotation
-    DataDecl { tcdLName    :: Located name        -- ^ Type constructor
-             , tcdTyVars   :: LHsQTyVars name  -- ^ Type variables; for an associated type
-                                                  --   these include outer binders
-                                                  -- Eg  class T a where
-                                                  --       type F a :: *
-                                                  --       type F a = a -> a
-                                                  -- Here the type decl for 'f' includes 'a'
-                                                  -- in its tcdTyVars
+    DataDecl { tcdLName    :: Located (IdP pass) -- ^ Type constructor
+             , tcdTyVars   :: LHsQTyVars pass  -- ^ Type variables; for an
+                                               -- associated type
+                                               --   these include outer binders
+                                               -- Eg  class T a where
+                                               --       type F a :: *
+                                               --       type F a = a -> a
+                                               -- Here the type decl for 'f'
+                                               -- includes 'a' in its tcdTyVars
              , tcdFixity  :: LexicalFixity -- ^ Fixity used in the declaration
-             , tcdDataDefn :: HsDataDefn name
-             , tcdDataCusk :: PostRn name Bool    -- ^ does this have a CUSK?
-             , tcdFVs      :: PostRn name NameSet }
+             , tcdDataDefn :: HsDataDefn pass
+             , tcdDataCusk :: PostRn pass Bool    -- ^ does this have a CUSK?
+             , tcdFVs      :: PostRn pass NameSet }
 
-  | ClassDecl { tcdCtxt    :: LHsContext name,          -- ^ Context...
-                tcdLName   :: Located name,             -- ^ Name of the class
-                tcdTyVars  :: LHsQTyVars name,          -- ^ Class type variables
+  | ClassDecl { tcdCtxt    :: LHsContext pass,         -- ^ Context...
+                tcdLName   :: Located (IdP pass),      -- ^ Name of the class
+                tcdTyVars  :: LHsQTyVars pass,         -- ^ Class type variables
                 tcdFixity  :: LexicalFixity, -- ^ Fixity used in the declaration
-                tcdFDs     :: [Located (FunDep (Located name))],
+                tcdFDs     :: [Located (FunDep (Located (IdP pass)))],
                                                         -- ^ Functional deps
-                tcdSigs    :: [LSig name],              -- ^ Methods' signatures
-                tcdMeths   :: LHsBinds name,            -- ^ Default methods
-                tcdATs     :: [LFamilyDecl name],       -- ^ Associated types;
-                tcdATDefs  :: [LTyFamDefltEqn name],    -- ^ Associated type defaults
+                tcdSigs    :: [LSig pass],              -- ^ Methods' signatures
+                tcdMeths   :: LHsBinds pass,            -- ^ Default methods
+                tcdATs     :: [LFamilyDecl pass],       -- ^ Associated types;
+                tcdATDefs  :: [LTyFamDefltEqn pass],
+                                                   -- ^ Associated type defaults
                 tcdDocs    :: [LDocDecl],               -- ^ Haddock docs
-                tcdFVs     :: PostRn name NameSet
+                tcdFVs     :: PostRn pass NameSet
     }
         -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnClass',
         --           'ApiAnnotation.AnnWhere','ApiAnnotation.AnnOpen',
@@ -536,27 +543,27 @@ deriving instance (DataId id) => Data (TyClDecl id)
 
 -- | @True@ <=> argument is a @data@\/@newtype@
 -- declaration.
-isDataDecl :: TyClDecl name -> Bool
+isDataDecl :: TyClDecl pass -> Bool
 isDataDecl (DataDecl {}) = True
 isDataDecl _other        = False
 
 -- | type or type instance declaration
-isSynDecl :: TyClDecl name -> Bool
+isSynDecl :: TyClDecl pass -> Bool
 isSynDecl (SynDecl {})   = True
 isSynDecl _other        = False
 
 -- | type class
-isClassDecl :: TyClDecl name -> Bool
+isClassDecl :: TyClDecl pass -> Bool
 isClassDecl (ClassDecl {}) = True
 isClassDecl _              = False
 
 -- | type/data family declaration
-isFamilyDecl :: TyClDecl name -> Bool
+isFamilyDecl :: TyClDecl pass -> Bool
 isFamilyDecl (FamDecl {})  = True
 isFamilyDecl _other        = False
 
 -- | type family declaration
-isTypeFamilyDecl :: TyClDecl name -> Bool
+isTypeFamilyDecl :: TyClDecl pass -> Bool
 isTypeFamilyDecl (FamDecl (FamilyDecl { fdInfo = info })) = case info of
   OpenTypeFamily      -> True
   ClosedTypeFamily {} -> True
@@ -564,42 +571,42 @@ isTypeFamilyDecl (FamDecl (FamilyDecl { fdInfo = info })) = case info of
 isTypeFamilyDecl _ = False
 
 -- | open type family info
-isOpenTypeFamilyInfo :: FamilyInfo name -> Bool
+isOpenTypeFamilyInfo :: FamilyInfo pass -> Bool
 isOpenTypeFamilyInfo OpenTypeFamily = True
 isOpenTypeFamilyInfo _              = False
 
 -- | closed type family info
-isClosedTypeFamilyInfo :: FamilyInfo name -> Bool
+isClosedTypeFamilyInfo :: FamilyInfo pass -> Bool
 isClosedTypeFamilyInfo (ClosedTypeFamily {}) = True
 isClosedTypeFamilyInfo _                     = False
 
 -- | data family declaration
-isDataFamilyDecl :: TyClDecl name -> Bool
+isDataFamilyDecl :: TyClDecl pass -> Bool
 isDataFamilyDecl (FamDecl (FamilyDecl { fdInfo = DataFamily })) = True
 isDataFamilyDecl _other      = False
 
 -- Dealing with names
 
-tyFamInstDeclName :: TyFamInstDecl name -> name
+tyFamInstDeclName :: TyFamInstDecl pass -> (IdP pass)
 tyFamInstDeclName = unLoc . tyFamInstDeclLName
 
-tyFamInstDeclLName :: TyFamInstDecl name -> Located name
+tyFamInstDeclLName :: TyFamInstDecl pass -> Located (IdP pass)
 tyFamInstDeclLName (TyFamInstDecl { tfid_eqn =
                      (L _ (TyFamEqn { tfe_tycon = ln })) })
   = ln
 
-tyClDeclLName :: TyClDecl name -> Located name
+tyClDeclLName :: TyClDecl pass -> Located (IdP pass)
 tyClDeclLName (FamDecl { tcdFam = FamilyDecl { fdLName = ln } }) = ln
 tyClDeclLName decl = tcdLName decl
 
-tcdName :: TyClDecl name -> name
+tcdName :: TyClDecl pass -> (IdP pass)
 tcdName = unLoc . tyClDeclLName
 
-tyClDeclTyVars :: TyClDecl name -> LHsQTyVars name
+tyClDeclTyVars :: TyClDecl pass -> LHsQTyVars pass
 tyClDeclTyVars (FamDecl { tcdFam = FamilyDecl { fdTyVars = tvs } }) = tvs
 tyClDeclTyVars d = tcdTyVars d
 
-countTyClDecls :: [TyClDecl name] -> (Int, Int, Int, Int, Int)
+countTyClDecls :: [TyClDecl pass] -> (Int, Int, Int, Int, Int)
         -- class, synonym decls, data, newtype, family decls
 countTyClDecls decls
  = (count isClassDecl    decls,
@@ -616,7 +623,7 @@ countTyClDecls decls
 
 -- | Does this declaration have a complete, user-supplied kind signature?
 -- See Note [Complete user-supplied kind signatures]
-hsDeclHasCusk :: TyClDecl Name -> Bool
+hsDeclHasCusk :: TyClDecl GhcRn -> Bool
 hsDeclHasCusk (FamDecl { tcdFam = fam_decl }) = famDeclHasCusk Nothing fam_decl
 hsDeclHasCusk (SynDecl { tcdTyVars = tyvars, tcdRhs = rhs })
   -- NB: Keep this synchronized with 'getInitialKind'
@@ -632,7 +639,8 @@ hsDeclHasCusk (ClassDecl { tcdTyVars = tyvars }) = hsTvbAllKinded tyvars
 -- Pretty-printing TyClDecl
 -- ~~~~~~~~~~~~~~~~~~~~~~~~
 
-instance (OutputableBndrId name) => Outputable (TyClDecl name) where
+instance (SourceTextX pass, OutputableBndrId pass)
+       => Outputable (TyClDecl pass) where
 
     ppr (FamDecl { tcdFam = decl }) = ppr decl
     ppr (SynDecl { tcdLName = ltycon, tcdTyVars = tyvars, tcdFixity = fixity
@@ -663,7 +671,8 @@ instance (OutputableBndrId name) => Outputable (TyClDecl name) where
                     <+> pp_vanilla_decl_head lclas tyvars fixity (unLoc context)
                     <+> pprFundeps (map unLoc fds)
 
-instance (OutputableBndrId name) => Outputable (TyClGroup name) where
+instance (SourceTextX pass, OutputableBndrId pass)
+       => Outputable (TyClGroup pass) where
   ppr (TyClGroup { group_tyclds = tyclds
                  , group_roles = roles
                  , group_instds = instds
@@ -673,10 +682,11 @@ instance (OutputableBndrId name) => Outputable (TyClGroup name) where
       ppr roles $$
       ppr instds
 
-pp_vanilla_decl_head :: (OutputableBndrId name) => Located name
-   -> LHsQTyVars name
+pp_vanilla_decl_head :: (SourceTextX pass, OutputableBndrId pass)
+   => Located (IdP pass)
+   -> LHsQTyVars pass
    -> LexicalFixity
-   -> HsContext name
+   -> HsContext pass
    -> SDoc
 pp_vanilla_decl_head thing (HsQTvs { hsq_explicit = tyvars }) fixity context
  = hsep [pprHsContext context, pp_tyvars tyvars]
@@ -762,25 +772,25 @@ in RnSource for more info.
 -}
 
 -- | Type or Class Group
-data TyClGroup name  -- See Note [TyClGroups and dependency analysis]
-  = TyClGroup { group_tyclds :: [LTyClDecl name]
-              , group_roles  :: [LRoleAnnotDecl name]
-              , group_instds :: [LInstDecl name] }
+data TyClGroup pass  -- See Note [TyClGroups and dependency analysis]
+  = TyClGroup { group_tyclds :: [LTyClDecl pass]
+              , group_roles  :: [LRoleAnnotDecl pass]
+              , group_instds :: [LInstDecl pass] }
 deriving instance (DataId id) => Data (TyClGroup id)
 
-emptyTyClGroup :: TyClGroup name
+emptyTyClGroup :: TyClGroup pass
 emptyTyClGroup = TyClGroup [] [] []
 
-tyClGroupTyClDecls :: [TyClGroup name] -> [LTyClDecl name]
+tyClGroupTyClDecls :: [TyClGroup pass] -> [LTyClDecl pass]
 tyClGroupTyClDecls = concatMap group_tyclds
 
-tyClGroupInstDecls :: [TyClGroup name] -> [LInstDecl name]
+tyClGroupInstDecls :: [TyClGroup pass] -> [LInstDecl pass]
 tyClGroupInstDecls = concatMap group_instds
 
-tyClGroupRoleDecls :: [TyClGroup name] -> [LRoleAnnotDecl name]
+tyClGroupRoleDecls :: [TyClGroup pass] -> [LRoleAnnotDecl pass]
 tyClGroupRoleDecls = concatMap group_roles
 
-mkTyClGroup :: [LTyClDecl name] -> [LInstDecl name] -> TyClGroup name
+mkTyClGroup :: [LTyClDecl pass] -> [LInstDecl pass] -> TyClGroup pass
 mkTyClGroup decls instds = TyClGroup
   { group_tyclds = decls
   , group_roles = []
@@ -859,42 +869,42 @@ See also Note [Injective type families] in TyCon
 -}
 
 -- | Located type Family Result Signature
-type LFamilyResultSig name = Located (FamilyResultSig name)
+type LFamilyResultSig pass = Located (FamilyResultSig pass)
 
 -- | type Family Result Signature
-data FamilyResultSig name = -- see Note [FamilyResultSig]
+data FamilyResultSig pass = -- see Note [FamilyResultSig]
     NoSig
   -- ^ - 'ApiAnnotation.AnnKeywordId' :
 
   -- For details on above see note [Api annotations] in ApiAnnotation
 
-  | KindSig  (LHsKind name)
+  | KindSig  (LHsKind pass)
   -- ^ - 'ApiAnnotation.AnnKeywordId' :
   --             'ApiAnnotation.AnnOpenP','ApiAnnotation.AnnDcolon',
   --             'ApiAnnotation.AnnCloseP'
 
   -- For details on above see note [Api annotations] in ApiAnnotation
 
-  | TyVarSig (LHsTyVarBndr name)
+  | TyVarSig (LHsTyVarBndr pass)
   -- ^ - 'ApiAnnotation.AnnKeywordId' :
   --             'ApiAnnotation.AnnOpenP','ApiAnnotation.AnnDcolon',
   --             'ApiAnnotation.AnnCloseP', 'ApiAnnotation.AnnEqual'
 
   -- For details on above see note [Api annotations] in ApiAnnotation
 
-deriving instance (DataId name) => Data (FamilyResultSig name)
+deriving instance (DataId pass) => Data (FamilyResultSig pass)
 
 -- | Located type Family Declaration
-type LFamilyDecl name = Located (FamilyDecl name)
+type LFamilyDecl pass = Located (FamilyDecl pass)
 
 -- | type Family Declaration
-data FamilyDecl name = FamilyDecl
-  { fdInfo           :: FamilyInfo name              -- type/data, closed/open
-  , fdLName          :: Located name                 -- type constructor
-  , fdTyVars         :: LHsQTyVars name              -- type variables
+data FamilyDecl pass = FamilyDecl
+  { fdInfo           :: FamilyInfo pass              -- type/data, closed/open
+  , fdLName          :: Located (IdP pass)           -- type constructor
+  , fdTyVars         :: LHsQTyVars pass              -- type variables
   , fdFixity         :: LexicalFixity         -- Fixity used in the declaration
-  , fdResultSig      :: LFamilyResultSig name        -- result signature
-  , fdInjectivityAnn :: Maybe (LInjectivityAnn name) -- optional injectivity ann
+  , fdResultSig      :: LFamilyResultSig pass        -- result signature
+  , fdInjectivityAnn :: Maybe (LInjectivityAnn pass) -- optional injectivity ann
   }
   -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType',
   --             'ApiAnnotation.AnnData', 'ApiAnnotation.AnnFamily',
@@ -908,7 +918,7 @@ data FamilyDecl name = FamilyDecl
 deriving instance (DataId id) => Data (FamilyDecl id)
 
 -- | Located Injectivity Annotation
-type LInjectivityAnn name = Located (InjectivityAnn name)
+type LInjectivityAnn pass = Located (InjectivityAnn pass)
 
 -- | If the user supplied an injectivity annotation it is represented using
 -- InjectivityAnn. At the moment this is a single injectivity condition - see
@@ -918,26 +928,26 @@ type LInjectivityAnn name = Located (InjectivityAnn name)
 --   type family Foo a b c = r | r -> a c where ...
 --
 -- This will be represented as "InjectivityAnn `r` [`a`, `c`]"
-data InjectivityAnn name
-  = InjectivityAnn (Located name) [Located name]
+data InjectivityAnn pass
+  = InjectivityAnn (Located (IdP pass)) [Located (IdP pass)]
   -- ^ - 'ApiAnnotation.AnnKeywordId' :
   --             'ApiAnnotation.AnnRarrow', 'ApiAnnotation.AnnVbar'
 
   -- For details on above see note [Api annotations] in ApiAnnotation
-  deriving Data
+deriving instance (DataId pass) => Data (InjectivityAnn pass)
 
-data FamilyInfo name
+data FamilyInfo pass
   = DataFamily
   | OpenTypeFamily
      -- | 'Nothing' if we're in an hs-boot file and the user
      -- said "type family Foo x where .."
-  | ClosedTypeFamily (Maybe [LTyFamInstEqn name])
-deriving instance (DataId name) => Data (FamilyInfo name)
+  | ClosedTypeFamily (Maybe [LTyFamInstEqn pass])
+deriving instance (DataId pass) => Data (FamilyInfo pass)
 
 -- | Does this family declaration have a complete, user-supplied kind signature?
 famDeclHasCusk :: Maybe Bool
                    -- ^ if associated, does the enclosing class have a CUSK?
-               -> FamilyDecl name -> Bool
+               -> FamilyDecl pass -> Bool
 famDeclHasCusk _ (FamilyDecl { fdInfo      = ClosedTypeFamily _
                              , fdTyVars    = tyvars
                              , fdResultSig = L _ resultSig })
@@ -952,15 +962,16 @@ hasReturnKindSignature (TyVarSig (L _ (UserTyVar _))) = False
 hasReturnKindSignature _                              = True
 
 -- | Maybe return name of the result type variable
-resultVariableName :: FamilyResultSig a -> Maybe a
+resultVariableName :: FamilyResultSig a -> Maybe (IdP a)
 resultVariableName (TyVarSig sig) = Just $ hsLTyVarName sig
 resultVariableName _              = Nothing
 
-instance (OutputableBndrId name) => Outputable (FamilyDecl name) where
+instance (SourceTextX pass, OutputableBndrId pass)
+       => Outputable (FamilyDecl pass) where
   ppr = pprFamilyDecl TopLevel
 
-pprFamilyDecl :: (OutputableBndrId name)
-              => TopLevelFlag -> FamilyDecl name -> SDoc
+pprFamilyDecl :: (SourceTextX pass, OutputableBndrId pass)
+              => TopLevelFlag -> FamilyDecl pass -> SDoc
 pprFamilyDecl top_level (FamilyDecl { fdInfo = info, fdLName = ltycon
                                     , fdTyVars = tyvars
                                     , fdFixity = fixity
@@ -991,12 +1002,12 @@ pprFamilyDecl top_level (FamilyDecl { fdInfo = info, fdLName = ltycon
             Just eqns -> vcat $ map ppr_fam_inst_eqn eqns )
       _ -> (empty, empty)
 
-pprFlavour :: FamilyInfo name -> SDoc
+pprFlavour :: FamilyInfo pass -> SDoc
 pprFlavour DataFamily            = text "data"
 pprFlavour OpenTypeFamily        = text "type"
 pprFlavour (ClosedTypeFamily {}) = text "type"
 
-instance Outputable (FamilyInfo name) where
+instance Outputable (FamilyInfo pass) where
   ppr info = pprFlavour info <+> text "family"
 
 
@@ -1008,7 +1019,7 @@ instance Outputable (FamilyInfo name) where
 ********************************************************************* -}
 
 -- | Haskell Data type Definition
-data HsDataDefn name   -- The payload of a data type defn
+data HsDataDefn pass   -- The payload of a data type defn
                        -- Used *both* for vanilla data declarations,
                        --       *and* for data family instances
   = -- | Declares a data type or newtype, giving its constructors
@@ -1017,9 +1028,9 @@ data HsDataDefn name   -- The payload of a data type defn
     --  data/newtype instance T [a] = <constrs>
     -- @
     HsDataDefn { dd_ND     :: NewOrData,
-                 dd_ctxt   :: LHsContext name,           -- ^ Context
+                 dd_ctxt   :: LHsContext pass,           -- ^ Context
                  dd_cType  :: Maybe (Located CType),
-                 dd_kindSig:: Maybe (LHsKind name),
+                 dd_kindSig:: Maybe (LHsKind pass),
                      -- ^ Optional kind signature.
                      --
                      -- @(Just k)@ for a GADT-style @data@,
@@ -1027,7 +1038,7 @@ data HsDataDefn name   -- The payload of a data type defn
                      --
                      -- Always @Nothing@ for H98-syntax decls
 
-                 dd_cons   :: [LConDecl name],
+                 dd_cons   :: [LConDecl pass],
                      -- ^ Data constructors
                      --
                      -- For @data T a = T1 | T2 a@
@@ -1035,14 +1046,14 @@ data HsDataDefn name   -- The payload of a data type defn
                      -- For @data T a where { T1 :: T a }@
                      --   the 'LConDecls' all have 'ConDeclGADT'.
 
-                 dd_derivs :: HsDeriving name  -- ^ Optional 'deriving' claues
+                 dd_derivs :: HsDeriving pass  -- ^ Optional 'deriving' claues
 
              -- For details on above see note [Api annotations] in ApiAnnotation
    }
 deriving instance (DataId id) => Data (HsDataDefn id)
 
 -- | Haskell Deriving clause
-type HsDeriving name = Located [LHsDerivingClause name]
+type HsDeriving pass = Located [LHsDerivingClause pass]
   -- ^ The optional @deriving@ clauses of a data declaration. "Clauses" is
   -- plural because one can specify multiple deriving clauses using the
   -- @-XDerivingStrategies@ language extension.
@@ -1051,7 +1062,7 @@ type HsDeriving name = Located [LHsDerivingClause name]
   -- requested to derive, in order. If no deriving clauses were specified,
   -- the list is empty.
 
-type LHsDerivingClause name = Located (HsDerivingClause name)
+type LHsDerivingClause pass = Located (HsDerivingClause pass)
 
 -- | A single @deriving@ clause of a data declaration.
 --
@@ -1059,13 +1070,13 @@ type LHsDerivingClause name = Located (HsDerivingClause name)
 --       'ApiAnnotation.AnnDeriving', 'ApiAnnotation.AnnStock',
 --       'ApiAnnotation.AnnAnyClass', 'Api.AnnNewtype',
 --       'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose'
-data HsDerivingClause name
+data HsDerivingClause pass
   -- See Note [Deriving strategies] in TcDeriv
   = HsDerivingClause
     { deriv_clause_strategy :: Maybe (Located DerivStrategy)
       -- ^ The user-specified strategy (if any) to use when deriving
       -- 'deriv_clause_tys'.
-    , deriv_clause_tys :: Located [LHsSigType name]
+    , deriv_clause_tys :: Located [LHsSigType pass]
       -- ^ The types to derive.
       --
       -- It uses 'LHsSigType's because, with @-XGeneralizedNewtypeDeriving@,
@@ -1077,8 +1088,8 @@ data HsDerivingClause name
     }
 deriving instance (DataId id) => Data (HsDerivingClause id)
 
-instance (OutputableBndrId name)
-       => Outputable (HsDerivingClause name) where
+instance (SourceTextX pass, OutputableBndrId pass)
+       => Outputable (HsDerivingClause pass) where
   ppr (HsDerivingClause { deriv_clause_strategy = dcs
                         , deriv_clause_tys      = L _ dct })
     = hsep [ text "deriving"
@@ -1098,7 +1109,7 @@ data NewOrData
   deriving( Eq, Data )                -- Needed because Demand derives Eq
 
 -- | Located data Constructor Declaration
-type LConDecl name = Located (ConDecl name)
+type LConDecl pass = Located (ConDecl pass)
       -- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi' when
       --   in a GADT constructor list
 
@@ -1129,57 +1140,57 @@ type LConDecl name = Located (ConDecl name)
 -- For details on above see note [Api annotations] in ApiAnnotation
 
 -- | data Constructor Declaration
-data ConDecl name
+data ConDecl pass
   = ConDeclGADT
-      { con_names   :: [Located name]
-      , con_type    :: LHsSigType name
+      { con_names   :: [Located (IdP pass)]
+      , con_type    :: LHsSigType pass
         -- ^ The type after the ‘::’
       , con_doc     :: Maybe LHsDocString
           -- ^ A possible Haddock comment.
       }
 
   | ConDeclH98
-      { con_name    :: Located name
+      { con_name    :: Located (IdP pass)
 
-      , con_qvars     :: Maybe (LHsQTyVars name)
+      , con_qvars     :: Maybe (LHsQTyVars pass)
         -- User-written forall (if any), and its implicit
         -- kind variables
         -- Non-Nothing needs -XExistentialQuantification
         --               e.g. data T a = forall b. MkT b (b->a)
         --               con_qvars = {b}
 
-      , con_cxt       :: Maybe (LHsContext name)
+      , con_cxt       :: Maybe (LHsContext pass)
         -- ^ User-written context (if any)
 
-      , con_details   :: HsConDeclDetails name
+      , con_details   :: HsConDeclDetails pass
           -- ^ Arguments
 
       , con_doc       :: Maybe LHsDocString
           -- ^ A possible Haddock comment.
       }
-deriving instance (DataId name) => Data (ConDecl name)
+deriving instance (DataId pass) => Data (ConDecl pass)
 
 -- | Haskell data Constructor Declaration Details
-type HsConDeclDetails name
-   = HsConDetails (LBangType name) (Located [LConDeclField name])
+type HsConDeclDetails pass
+   = HsConDetails (LBangType pass) (Located [LConDeclField pass])
 
-getConNames :: ConDecl name -> [Located name]
+getConNames :: ConDecl pass -> [Located (IdP pass)]
 getConNames ConDeclH98  {con_name  = name}  = [name]
 getConNames ConDeclGADT {con_names = names} = names
 
 -- don't call with RdrNames, because it can't deal with HsAppsTy
-getConDetails :: ConDecl name -> HsConDeclDetails name
+getConDetails :: ConDecl pass -> HsConDeclDetails pass
 getConDetails ConDeclH98  {con_details  = details} = details
 getConDetails ConDeclGADT {con_type     = ty     } = details
   where
     (details,_,_,_) = gadtDeclDetails ty
 
 -- don't call with RdrNames, because it can't deal with HsAppsTy
-gadtDeclDetails :: LHsSigType name
-                -> ( HsConDeclDetails name
-                   , LHsType name
-                   , LHsContext name
-                   , [LHsTyVarBndr name] )
+gadtDeclDetails :: LHsSigType pass
+                -> ( HsConDeclDetails pass
+                   , LHsType pass
+                   , LHsContext pass
+                   , [LHsTyVarBndr pass] )
 gadtDeclDetails HsIB {hsib_body = lbody_ty} = (details,res_ty,cxt,tvs)
   where
     (tvs, cxt, tau) = splitLHsSigmaTy lbody_ty
@@ -1189,14 +1200,14 @@ gadtDeclDetails HsIB {hsib_body = lbody_ty} = (details,res_ty,cxt,tvs)
                   -> (RecCon (L l flds), res_ty')
           _other  -> (PrefixCon [], tau)
 
-hsConDeclArgTys :: HsConDeclDetails name -> [LBangType name]
+hsConDeclArgTys :: HsConDeclDetails pass -> [LBangType pass]
 hsConDeclArgTys (PrefixCon tys)    = tys
 hsConDeclArgTys (InfixCon ty1 ty2) = [ty1,ty2]
 hsConDeclArgTys (RecCon flds)      = map (cd_fld_type . unLoc) (unLoc flds)
 
-pp_data_defn :: (OutputableBndrId name)
-                  => (HsContext name -> SDoc)   -- Printing the header
-                  -> HsDataDefn name
+pp_data_defn :: (SourceTextX pass, OutputableBndrId pass)
+                  => (HsContext pass -> SDoc)   -- Printing the header
+                  -> HsDataDefn pass
                   -> SDoc
 pp_data_defn pp_hdr (HsDataDefn { dd_ND = new_or_data, dd_ctxt = L _ context
                                 , dd_cType = mb_ct
@@ -1218,23 +1229,26 @@ pp_data_defn pp_hdr (HsDataDefn { dd_ND = new_or_data, dd_ctxt = L _ context
                Just kind -> dcolon <+> ppr kind
     pp_derivings (L _ ds) = vcat (map ppr ds)
 
-instance (OutputableBndrId name) => Outputable (HsDataDefn name) where
+instance (SourceTextX pass, OutputableBndrId pass)
+       => Outputable (HsDataDefn pass) where
    ppr d = pp_data_defn (\_ -> text "Naked HsDataDefn") d
 
 instance Outputable NewOrData where
   ppr NewType  = text "newtype"
   ppr DataType = text "data"
 
-pp_condecls :: (OutputableBndrId name) => [LConDecl name] -> SDoc
+pp_condecls :: (SourceTextX pass, OutputableBndrId pass)
+            => [LConDecl pass] -> SDoc
 pp_condecls cs@(L _ ConDeclGADT{} : _) -- In GADT syntax
   = hang (text "where") 2 (vcat (map ppr cs))
 pp_condecls cs                    -- In H98 syntax
   = equals <+> sep (punctuate (text " |") (map ppr cs))
 
-instance (OutputableBndrId name) => Outputable (ConDecl name) where
+instance (SourceTextX pass, OutputableBndrId pass)
+       => Outputable (ConDecl pass) where
     ppr = pprConDecl
 
-pprConDecl :: (OutputableBndrId name) => ConDecl name -> SDoc
+pprConDecl :: (SourceTextX pass, OutputableBndrId pass) => ConDecl pass -> SDoc
 pprConDecl (ConDeclH98 { con_name = L _ con
                        , con_qvars = mtvs
                        , con_cxt = mcxt
@@ -1257,7 +1271,7 @@ pprConDecl (ConDeclGADT { con_names = cons, con_type = res_ty, con_doc = doc })
   = sep [ppr_mbDoc doc <+> ppr_con_names cons <+> dcolon
          <+> ppr res_ty]
 
-ppr_con_names :: (OutputableBndr name) => [Located name] -> SDoc
+ppr_con_names :: (OutputableBndr a) => [Located a] -> SDoc
 ppr_con_names = pprWithCommas (pprPrefixOcc . unLoc)
 
 {-
@@ -1289,17 +1303,17 @@ It is parameterised over its tfe_pats field:
 ----------------- Type synonym family instances -------------
 
 -- | Located Type Family Instance Equation
-type LTyFamInstEqn  name = Located (TyFamInstEqn  name)
+type LTyFamInstEqn  pass = Located (TyFamInstEqn  pass)
   -- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi'
   --   when in a list
 
 -- For details on above see note [Api annotations] in ApiAnnotation
 
 -- | Located Type Family Default Equation
-type LTyFamDefltEqn name = Located (TyFamDefltEqn name)
+type LTyFamDefltEqn pass = Located (TyFamDefltEqn pass)
 
 -- | Haskell Type Patterns
-type HsTyPats name = HsImplicitBndrs name [LHsType name]
+type HsTyPats pass = HsImplicitBndrs pass [LHsType pass]
             -- ^ Type patterns (with kind and type bndrs)
             -- See Note [Family instance declaration binders]
 
@@ -1333,56 +1347,57 @@ type patterns, i.e. fv(pat_tys).  Note in particular
 -}
 
 -- | Type Family Instance Equation
-type TyFamInstEqn  name = TyFamEqn name (HsTyPats name)
+type TyFamInstEqn  pass = TyFamEqn pass (HsTyPats pass)
 
 -- | Type Family Default Equation
-type TyFamDefltEqn name = TyFamEqn name (LHsQTyVars name)
+type TyFamDefltEqn pass = TyFamEqn pass (LHsQTyVars pass)
   -- See Note [Type family instance declarations in HsSyn]
 
 -- | Type Family Equation
 --
 -- One equation in a type family instance declaration
 -- See Note [Type family instance declarations in HsSyn]
-data TyFamEqn name pats
+data TyFamEqn pass pats
   = TyFamEqn
-       { tfe_tycon  :: Located name
+       { tfe_tycon  :: Located (IdP pass)
        , tfe_pats   :: pats
        , tfe_fixity :: LexicalFixity    -- ^ Fixity used in the declaration
-       , tfe_rhs    :: LHsType name }
+       , tfe_rhs    :: LHsType pass }
     -- ^
     --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnEqual'
 
     -- For details on above see note [Api annotations] in ApiAnnotation
-deriving instance (DataId name, Data pats) => Data (TyFamEqn name pats)
+deriving instance (DataId pass, Data pats) => Data (TyFamEqn pass pats)
 
 -- | Located Type Family Instance Declaration
-type LTyFamInstDecl name = Located (TyFamInstDecl name)
+type LTyFamInstDecl pass = Located (TyFamInstDecl pass)
 
 -- | Type Family Instance Declaration
-data TyFamInstDecl name
+data TyFamInstDecl pass
   = TyFamInstDecl
-       { tfid_eqn  :: LTyFamInstEqn name
-       , tfid_fvs  :: PostRn name NameSet }
+       { tfid_eqn  :: LTyFamInstEqn pass
+       , tfid_fvs  :: PostRn pass NameSet }
     -- ^
     --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType',
     --           'ApiAnnotation.AnnInstance',
 
     -- For details on above see note [Api annotations] in ApiAnnotation
-deriving instance (DataId name) => Data (TyFamInstDecl name)
+deriving instance (DataId pass) => Data (TyFamInstDecl pass)
 
 ----------------- Data family instances -------------
 
 -- | Located Data Family Instance Declaration
-type LDataFamInstDecl name = Located (DataFamInstDecl name)
+type LDataFamInstDecl pass = Located (DataFamInstDecl pass)
 
 -- | Data Family Instance Declaration
-data DataFamInstDecl name
+data DataFamInstDecl pass
   = DataFamInstDecl
-       { dfid_tycon     :: Located name
-       , dfid_pats      :: HsTyPats   name       -- LHS
+       { dfid_tycon     :: Located (IdP pass)
+       , dfid_pats      :: HsTyPats   pass       -- LHS
        , dfid_fixity    :: LexicalFixity    -- ^ Fixity used in the declaration
-       , dfid_defn      :: HsDataDefn name       -- RHS
-       , dfid_fvs       :: PostRn name NameSet } -- Free vars for dependency analysis
+       , dfid_defn      :: HsDataDefn pass       -- RHS
+       , dfid_fvs       :: PostRn pass NameSet }
+                                           -- Free vars for dependency analysis
     -- ^
     --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnData',
     --           'ApiAnnotation.AnnNewType','ApiAnnotation.AnnInstance',
@@ -1391,24 +1406,24 @@ data DataFamInstDecl name
     --           'ApiAnnotation.AnnClose'
 
     -- For details on above see note [Api annotations] in ApiAnnotation
-deriving instance (DataId name) => Data (DataFamInstDecl name)
+deriving instance (DataId pass) => Data (DataFamInstDecl pass)
 
 
 ----------------- Class instances -------------
 
 -- | Located Class Instance Declaration
-type LClsInstDecl name = Located (ClsInstDecl name)
+type LClsInstDecl pass = Located (ClsInstDecl pass)
 
 -- | Class Instance Declaration
-data ClsInstDecl name
+data ClsInstDecl pass
   = ClsInstDecl
-      { cid_poly_ty :: LHsSigType name    -- Context => Class Instance-type
+      { cid_poly_ty :: LHsSigType pass    -- Context => Class Instance-type
                                           -- Using a polytype means that the renamer conveniently
                                           -- figures out the quantified type variables for us.
-      , cid_binds         :: LHsBinds name           -- Class methods
-      , cid_sigs          :: [LSig name]             -- User-supplied pragmatic info
-      , cid_tyfam_insts   :: [LTyFamInstDecl name]   -- Type family instances
-      , cid_datafam_insts :: [LDataFamInstDecl name] -- Data family instances
+      , cid_binds         :: LHsBinds pass       -- Class methods
+      , cid_sigs          :: [LSig pass]         -- User-supplied pragmatic info
+      , cid_tyfam_insts   :: [LTyFamInstDecl pass]   -- Type family instances
+      , cid_datafam_insts :: [LDataFamInstDecl pass] -- Data family instances
       , cid_overlap_mode  :: Maybe (Located OverlapMode)
          -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
          --                                    'ApiAnnotation.AnnClose',
@@ -1427,23 +1442,24 @@ deriving instance (DataId id) => Data (ClsInstDecl id)
 ----------------- Instances of all kinds -------------
 
 -- | Located Instance Declaration
-type LInstDecl name = Located (InstDecl name)
+type LInstDecl pass = Located (InstDecl pass)
 
 -- | Instance Declaration
-data InstDecl name  -- Both class and family instances
+data InstDecl pass  -- Both class and family instances
   = ClsInstD
-      { cid_inst  :: ClsInstDecl name }
+      { cid_inst  :: ClsInstDecl pass }
   | DataFamInstD              -- data family instance
-      { dfid_inst :: DataFamInstDecl name }
+      { dfid_inst :: DataFamInstDecl pass }
   | TyFamInstD              -- type family instance
-      { tfid_inst :: TyFamInstDecl name }
+      { tfid_inst :: TyFamInstDecl pass }
 deriving instance (DataId id) => Data (InstDecl id)
 
-instance (OutputableBndrId name) => Outputable (TyFamInstDecl name) where
+instance (SourceTextX pass, OutputableBndrId pass)
+       => Outputable (TyFamInstDecl pass) where
   ppr = pprTyFamInstDecl TopLevel
 
-pprTyFamInstDecl :: (OutputableBndrId name)
-                 => TopLevelFlag -> TyFamInstDecl name -> SDoc
+pprTyFamInstDecl :: (SourceTextX pass, OutputableBndrId pass)
+                 => TopLevelFlag -> TyFamInstDecl pass -> SDoc
 pprTyFamInstDecl top_lvl (TyFamInstDecl { tfid_eqn = eqn })
    = text "type" <+> ppr_instance_keyword top_lvl <+> ppr_fam_inst_eqn eqn
 
@@ -1451,14 +1467,16 @@ ppr_instance_keyword :: TopLevelFlag -> SDoc
 ppr_instance_keyword TopLevel    = text "instance"
 ppr_instance_keyword NotTopLevel = empty
 
-ppr_fam_inst_eqn :: (OutputableBndrId name) => LTyFamInstEqn name -> SDoc
+ppr_fam_inst_eqn :: (SourceTextX pass, OutputableBndrId pass)
+                 => LTyFamInstEqn pass -> SDoc
 ppr_fam_inst_eqn (L _ (TyFamEqn { tfe_tycon = tycon
                                 , tfe_pats  = pats
                                 , tfe_fixity = fixity
                                 , tfe_rhs   = rhs }))
     = pp_fam_inst_lhs tycon pats fixity [] <+> equals <+> ppr rhs
 
-ppr_fam_deflt_eqn :: (OutputableBndrId name) => LTyFamDefltEqn name -> SDoc
+ppr_fam_deflt_eqn :: (SourceTextX pass, OutputableBndrId pass)
+                  => LTyFamDefltEqn pass -> SDoc
 ppr_fam_deflt_eqn (L _ (TyFamEqn { tfe_tycon = tycon
                                  , tfe_pats  = tvs
                                  , tfe_fixity = fixity
@@ -1466,11 +1484,12 @@ ppr_fam_deflt_eqn (L _ (TyFamEqn { tfe_tycon = tycon
     = text "type" <+> pp_vanilla_decl_head tycon tvs fixity []
                   <+> equals <+> ppr rhs
 
-instance (OutputableBndrId name) => Outputable (DataFamInstDecl name) where
+instance (SourceTextX pass, OutputableBndrId pass)
+       => Outputable (DataFamInstDecl pass) where
   ppr = pprDataFamInstDecl TopLevel
 
-pprDataFamInstDecl :: (OutputableBndrId name)
-                   => TopLevelFlag -> DataFamInstDecl name -> SDoc
+pprDataFamInstDecl :: (SourceTextX pass, OutputableBndrId pass)
+                   => TopLevelFlag -> DataFamInstDecl pass -> SDoc
 pprDataFamInstDecl top_lvl (DataFamInstDecl { dfid_tycon = tycon
                                             , dfid_pats  = pats
                                             , dfid_fixity = fixity
@@ -1480,14 +1499,15 @@ pprDataFamInstDecl top_lvl (DataFamInstDecl { dfid_tycon = tycon
     pp_hdr ctxt = ppr_instance_keyword top_lvl
               <+> pp_fam_inst_lhs tycon pats fixity ctxt
 
-pprDataFamInstFlavour :: DataFamInstDecl name -> SDoc
+pprDataFamInstFlavour :: DataFamInstDecl pass -> SDoc
 pprDataFamInstFlavour (DataFamInstDecl { dfid_defn = (HsDataDefn { dd_ND = nd }) })
   = ppr nd
 
-pp_fam_inst_lhs :: (OutputableBndrId name) => Located name
-   -> HsTyPats name
+pp_fam_inst_lhs :: (SourceTextX pass, OutputableBndrId pass)
+   => Located (IdP pass)
+   -> HsTyPats pass
    -> LexicalFixity
-   -> HsContext name
+   -> HsContext pass
    -> SDoc
 pp_fam_inst_lhs thing (HsIB { hsib_body = typats }) fixity context
                                               -- explicit type patterns
@@ -1501,7 +1521,8 @@ pp_fam_inst_lhs thing (HsIB { hsib_body = typats }) fixity context
                    , hsep (map (pprHsType.unLoc) (patl:patsr))]
      pp_pats [] = empty
 
-instance (OutputableBndrId name) => Outputable (ClsInstDecl name) where
+instance (SourceTextX pass, OutputableBndrId pass)
+       => Outputable (ClsInstDecl pass) where
     ppr (ClsInstDecl { cid_poly_ty = inst_ty, cid_binds = binds
                      , cid_sigs = sigs, cid_tyfam_insts = ats
                      , cid_overlap_mode = mbOverlap
@@ -1539,14 +1560,15 @@ ppOverlapPragma mb =
     maybe_stext (SourceText src) _   = text src <+> text "#-}"
 
 
-instance (OutputableBndrId name) => Outputable (InstDecl name) where
+instance (SourceTextX pass, OutputableBndrId pass)
+       => Outputable (InstDecl pass) where
     ppr (ClsInstD     { cid_inst  = decl }) = ppr decl
     ppr (TyFamInstD   { tfid_inst = decl }) = ppr decl
     ppr (DataFamInstD { dfid_inst = decl }) = ppr decl
 
 -- Extract the declarations of associated data types from an instance
 
-instDeclDataFamInsts :: [LInstDecl name] -> [DataFamInstDecl name]
+instDeclDataFamInsts :: [LInstDecl pass] -> [DataFamInstDecl pass]
 instDeclDataFamInsts inst_decls
   = concatMap do_one inst_decls
   where
@@ -1564,11 +1586,11 @@ instDeclDataFamInsts inst_decls
 -}
 
 -- | Located Deriving Declaration
-type LDerivDecl name = Located (DerivDecl name)
+type LDerivDecl pass = Located (DerivDecl pass)
 
 -- | Deriving Declaration
-data DerivDecl name = DerivDecl
-        { deriv_type         :: LHsSigType name
+data DerivDecl pass = DerivDecl
+        { deriv_type         :: LHsSigType pass
         , deriv_strategy     :: Maybe (Located DerivStrategy)
         , deriv_overlap_mode :: Maybe (Located OverlapMode)
          -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDeriving',
@@ -1578,9 +1600,10 @@ data DerivDecl name = DerivDecl
 
   -- For details on above see note [Api annotations] in ApiAnnotation
         }
-deriving instance (DataId name) => Data (DerivDecl name)
+deriving instance (DataId pass) => Data (DerivDecl pass)
 
-instance (OutputableBndrId name) => Outputable (DerivDecl name) where
+instance (SourceTextX pass, OutputableBndrId pass)
+       => Outputable (DerivDecl pass) where
     ppr (DerivDecl { deriv_type = ty
                    , deriv_strategy = ds
                    , deriv_overlap_mode = o })
@@ -1603,18 +1626,19 @@ syntax, and that restriction must be checked in the front end.
 -}
 
 -- | Located Default Declaration
-type LDefaultDecl name = Located (DefaultDecl name)
+type LDefaultDecl pass = Located (DefaultDecl pass)
 
 -- | Default Declaration
-data DefaultDecl name
-  = DefaultDecl [LHsType name]
+data DefaultDecl pass
+  = DefaultDecl [LHsType pass]
         -- ^ - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnDefault',
         --          'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose'
 
         -- For details on above see note [Api annotations] in ApiAnnotation
-deriving instance (DataId name) => Data (DefaultDecl name)
+deriving instance (DataId pass) => Data (DefaultDecl pass)
 
-instance (OutputableBndrId name) => Outputable (DefaultDecl name) where
+instance (SourceTextX pass, OutputableBndrId pass)
+       => Outputable (DefaultDecl pass) where
 
     ppr (DefaultDecl tys)
       = text "default" <+> parens (interpp'SP tys)
@@ -1634,20 +1658,20 @@ instance (OutputableBndrId name) => Outputable (DefaultDecl name) where
 --   has been used
 
 -- | Located Foreign Declaration
-type LForeignDecl name = Located (ForeignDecl name)
+type LForeignDecl pass = Located (ForeignDecl pass)
 
 -- | Foreign Declaration
-data ForeignDecl name
+data ForeignDecl pass
   = ForeignImport
-      { fd_name   :: Located name          -- defines this name
-      , fd_sig_ty :: LHsSigType name       -- sig_ty
-      , fd_co     :: PostTc name Coercion  -- rep_ty ~ sig_ty
+      { fd_name   :: Located (IdP pass)    -- defines this name
+      , fd_sig_ty :: LHsSigType pass       -- sig_ty
+      , fd_co     :: PostTc pass Coercion  -- rep_ty ~ sig_ty
       , fd_fi     :: ForeignImport }
 
   | ForeignExport
-      { fd_name   :: Located name          -- uses this name
-      , fd_sig_ty :: LHsSigType name       -- sig_ty
-      , fd_co     :: PostTc name Coercion  -- rep_ty ~ sig_ty
+      { fd_name   :: Located (IdP pass)    -- uses this name
+      , fd_sig_ty :: LHsSigType pass       -- sig_ty
+      , fd_co     :: PostTc pass Coercion  -- rep_ty ~ sig_ty
       , fd_fe     :: ForeignExport }
         -- ^
         --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnForeign',
@@ -1656,7 +1680,7 @@ data ForeignDecl name
 
         -- For details on above see note [Api annotations] in ApiAnnotation
 
-deriving instance (DataId name) => Data (ForeignDecl name)
+deriving instance (DataId pass) => Data (ForeignDecl pass)
 {-
     In both ForeignImport and ForeignExport:
         sig_ty is the type given in the Haskell code
@@ -1717,7 +1741,8 @@ data ForeignExport = CExport  (Located CExportSpec) -- contains the calling
 -- pretty printing of foreign declarations
 --
 
-instance (OutputableBndrId name) => Outputable (ForeignDecl name) where
+instance (SourceTextX pass, OutputableBndrId pass)
+       => Outputable (ForeignDecl pass) where
   ppr (ForeignImport { fd_name = n, fd_sig_ty = ty, fd_fi = fimport })
     = hang (text "foreign import" <+> ppr fimport <+> ppr n)
          2 (dcolon <+> ppr ty)
@@ -1766,29 +1791,29 @@ instance Outputable ForeignExport where
 -}
 
 -- | Located Rule Declarations
-type LRuleDecls name = Located (RuleDecls name)
+type LRuleDecls pass = Located (RuleDecls pass)
 
   -- Note [Pragma source text] in BasicTypes
 -- | Rule Declarations
-data RuleDecls name = HsRules { rds_src   :: SourceText
-                              , rds_rules :: [LRuleDecl name] }
-deriving instance (DataId name) => Data (RuleDecls name)
+data RuleDecls pass = HsRules { rds_src   :: SourceText
+                              , rds_rules :: [LRuleDecl pass] }
+deriving instance (DataId pass) => Data (RuleDecls pass)
 
 -- | Located Rule Declaration
-type LRuleDecl name = Located (RuleDecl name)
+type LRuleDecl pass = Located (RuleDecl pass)
 
 -- | Rule Declaration
-data RuleDecl name
+data RuleDecl pass
   = HsRule                             -- Source rule
         (Located (SourceText,RuleName)) -- Rule name
                -- Note [Pragma source text] in BasicTypes
         Activation
-        [LRuleBndr name]        -- Forall'd vars; after typechecking this
+        [LRuleBndr pass]        -- Forall'd vars; after typechecking this
                                 --   includes tyvars
-        (Located (HsExpr name)) -- LHS
-        (PostRn name NameSet)   -- Free-vars from the LHS
-        (Located (HsExpr name)) -- RHS
-        (PostRn name NameSet)   -- Free-vars from the RHS
+        (Located (HsExpr pass)) -- LHS
+        (PostRn pass NameSet)   -- Free-vars from the LHS
+        (Located (HsExpr pass)) -- RHS
+        (PostRn pass NameSet)   -- Free-vars from the RHS
         -- ^
         --  - 'ApiAnnotation.AnnKeywordId' :
         --           'ApiAnnotation.AnnOpen','ApiAnnotation.AnnTilde',
@@ -1798,37 +1823,39 @@ data RuleDecl name
         --           'ApiAnnotation.AnnEqual',
 
         -- For details on above see note [Api annotations] in ApiAnnotation
-deriving instance (DataId name) => Data (RuleDecl name)
+deriving instance (DataId pass) => Data (RuleDecl pass)
 
-flattenRuleDecls :: [LRuleDecls name] -> [LRuleDecl name]
+flattenRuleDecls :: [LRuleDecls pass] -> [LRuleDecl pass]
 flattenRuleDecls decls = concatMap (rds_rules . unLoc) decls
 
 -- | Located Rule Binder
-type LRuleBndr name = Located (RuleBndr name)
+type LRuleBndr pass = Located (RuleBndr pass)
 
 -- | Rule Binder
-data RuleBndr name
-  = RuleBndr (Located name)
-  | RuleBndrSig (Located name) (LHsSigWcType name)
+data RuleBndr pass
+  = RuleBndr (Located (IdP pass))
+  | RuleBndrSig (Located (IdP pass)) (LHsSigWcType pass)
         -- ^
         --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
         --     'ApiAnnotation.AnnDcolon','ApiAnnotation.AnnClose'
 
         -- For details on above see note [Api annotations] in ApiAnnotation
-deriving instance (DataId name) => Data (RuleBndr name)
+deriving instance (DataId pass) => Data (RuleBndr pass)
 
-collectRuleBndrSigTys :: [RuleBndr name] -> [LHsSigWcType name]
+collectRuleBndrSigTys :: [RuleBndr pass] -> [LHsSigWcType pass]
 collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ ty <- bndrs]
 
 pprFullRuleName :: Located (SourceText, RuleName) -> SDoc
 pprFullRuleName (L _ (st, n)) = pprWithSourceText st (doubleQuotes $ ftext n)
 
-instance (OutputableBndrId name) => Outputable (RuleDecls name) where
+instance (SourceTextX pass, OutputableBndrId pass)
+       => Outputable (RuleDecls pass) where
   ppr (HsRules st rules)
     = pprWithSourceText st (text "{-# RULES")
           <+> vcat (punctuate semi (map ppr rules)) <+> text "#-}"
 
-instance (OutputableBndrId name) => Outputable (RuleDecl name) where
+instance (SourceTextX pass, OutputableBndrId pass)
+       => Outputable (RuleDecl pass) where
   ppr (HsRule name act ns lhs _fv_lhs rhs _fv_rhs)
         = sep [pprFullRuleName name <+> ppr act,
                nest 4 (pp_forall <+> pprExpr (unLoc lhs)),
@@ -1837,7 +1864,8 @@ instance (OutputableBndrId name) => Outputable (RuleDecl name) where
           pp_forall | null ns   = empty
                     | otherwise = forAllLit <+> fsep (map ppr ns) <> dot
 
-instance (OutputableBndrId name) => Outputable (RuleBndr name) where
+instance (SourceTextX pass, OutputableBndrId pass)
+       => Outputable (RuleBndr pass) where
    ppr (RuleBndr name) = ppr name
    ppr (RuleBndrSig name ty) = parens (ppr name <> dcolon <> ppr ty)
 
@@ -1859,21 +1887,21 @@ A vectorisation pragma, one of
 -}
 
 -- | Located Vectorise Declaration
-type LVectDecl name = Located (VectDecl name)
+type LVectDecl pass = Located (VectDecl pass)
 
 -- | Vectorise Declaration
-data VectDecl name
+data VectDecl pass
   = HsVect
       SourceText   -- Note [Pragma source text] in BasicTypes
-      (Located name)
-      (LHsExpr name)
+      (Located (IdP pass))
+      (LHsExpr pass)
         -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
         --           'ApiAnnotation.AnnEqual','ApiAnnotation.AnnClose'
 
         -- For details on above see note [Api annotations] in ApiAnnotation
   | HsNoVect
       SourceText   -- Note [Pragma source text] in BasicTypes
-      (Located name)
+      (Located (IdP pass))
         -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
         --                                    'ApiAnnotation.AnnClose'
 
@@ -1881,8 +1909,8 @@ data VectDecl name
   | HsVectTypeIn                -- pre type-checking
       SourceText                -- Note [Pragma source text] in BasicTypes
       Bool                      -- 'TRUE' => SCALAR declaration
-      (Located name)
-      (Maybe (Located name))    -- 'Nothing' => no right-hand side
+      (Located (IdP pass))
+      (Maybe (Located (IdP pass))) -- 'Nothing' => no right-hand side
         -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
         --           'ApiAnnotation.AnnType','ApiAnnotation.AnnClose',
         --           'ApiAnnotation.AnnEqual'
@@ -1894,7 +1922,7 @@ data VectDecl name
       (Maybe TyCon)             -- 'Nothing' => no right-hand side
   | HsVectClassIn               -- pre type-checking
       SourceText                -- Note [Pragma source text] in BasicTypes
-      (Located name)
+      (Located (IdP pass))
         -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
         --           'ApiAnnotation.AnnClass','ApiAnnotation.AnnClose',
 
@@ -1902,12 +1930,12 @@ data VectDecl name
   | HsVectClassOut              -- post type-checking
       Class
   | HsVectInstIn                -- pre type-checking (always SCALAR)  !!!FIXME: should be superfluous now
-      (LHsSigType name)
+      (LHsSigType pass)
   | HsVectInstOut               -- post type-checking (always SCALAR) !!!FIXME: should be superfluous now
       ClsInst
-deriving instance (DataId name) => Data (VectDecl name)
+deriving instance (DataId pass) => Data (VectDecl pass)
 
-lvectDeclName :: NamedThing name => LVectDecl name -> Name
+lvectDeclName :: NamedThing (IdP pass) => LVectDecl pass -> Name
 lvectDeclName (L _ (HsVect _       (L _ name) _))    = getName name
 lvectDeclName (L _ (HsNoVect _     (L _ name)))      = getName name
 lvectDeclName (L _ (HsVectTypeIn _  _ (L _ name) _)) = getName name
@@ -1919,12 +1947,13 @@ lvectDeclName (L _ (HsVectInstIn _))
 lvectDeclName (L _ (HsVectInstOut  _))
   = panic "HsDecls.lvectDeclName: HsVectInstOut"
 
-lvectInstDecl :: LVectDecl name -> Bool
+lvectInstDecl :: LVectDecl pass -> Bool
 lvectInstDecl (L _ (HsVectInstIn _))  = True
 lvectInstDecl (L _ (HsVectInstOut _)) = True
 lvectInstDecl _                       = False
 
-instance (OutputableBndrId name) => Outputable (VectDecl name) where
+instance (SourceTextX pass, OutputableBndrId pass)
+       => Outputable (VectDecl pass) where
   ppr (HsVect _ v rhs)
     = sep [text "{-# VECTORISE" <+> ppr v,
            nest 4 $
@@ -1996,28 +2025,28 @@ We use exported entities for things to deprecate.
 -}
 
 -- | Located Warning Declarations
-type LWarnDecls name = Located (WarnDecls name)
+type LWarnDecls pass = Located (WarnDecls pass)
 
  -- Note [Pragma source text] in BasicTypes
 -- | Warning pragma Declarations
-data WarnDecls name = Warnings { wd_src :: SourceText
-                               , wd_warnings :: [LWarnDecl name]
+data WarnDecls pass = Warnings { wd_src :: SourceText
+                               , wd_warnings :: [LWarnDecl pass]
                                }
-  deriving Data
+deriving instance (DataId pass) => Data (WarnDecls pass)
 
 -- | Located Warning pragma Declaration
-type LWarnDecl name = Located (WarnDecl name)
+type LWarnDecl pass = Located (WarnDecl pass)
 
 -- | Warning pragma Declaration
-data WarnDecl name = Warning [Located name] WarningTxt
-  deriving Data
+data WarnDecl pass = Warning [Located (IdP pass)] WarningTxt
+deriving instance (DataId pass) => Data (WarnDecl pass)
 
-instance OutputableBndr name => Outputable (WarnDecls name) where
+instance OutputableBndr (IdP pass) => Outputable (WarnDecls pass) where
     ppr (Warnings (SourceText src) decls)
       = text src <+> vcat (punctuate comma (map ppr decls)) <+> text "#-}"
     ppr (Warnings NoSourceText _decls) = panic "WarnDecls"
 
-instance OutputableBndr name => Outputable (WarnDecl name) where
+instance OutputableBndr (IdP pass) => Outputable (WarnDecl pass) where
     ppr (Warning thing txt)
       = hsep ( punctuate comma (map ppr thing))
               <+> ppr txt
@@ -2031,21 +2060,22 @@ instance OutputableBndr name => Outputable (WarnDecl name) where
 -}
 
 -- | Located Annotation Declaration
-type LAnnDecl name = Located (AnnDecl name)
+type LAnnDecl pass = Located (AnnDecl pass)
 
 -- | Annotation Declaration
-data AnnDecl name = HsAnnotation
+data AnnDecl pass = HsAnnotation
                       SourceText -- Note [Pragma source text] in BasicTypes
-                      (AnnProvenance name) (Located (HsExpr name))
+                      (AnnProvenance (IdP pass)) (Located (HsExpr pass))
       -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
       --           'ApiAnnotation.AnnType'
       --           'ApiAnnotation.AnnModule'
       --           'ApiAnnotation.AnnClose'
 
       -- For details on above see note [Api annotations] in ApiAnnotation
-deriving instance (DataId name) => Data (AnnDecl name)
+deriving instance (DataId pass) => Data (AnnDecl pass)
 
-instance (OutputableBndrId name) => Outputable (AnnDecl name) where
+instance (SourceTextX pass, OutputableBndrId pass)
+       => Outputable (AnnDecl pass) where
     ppr (HsAnnotation _ provenance expr)
       = hsep [text "{-#", pprAnnProvenance provenance, pprExpr (unLoc expr), text "#-}"]
 
@@ -2053,9 +2083,10 @@ instance (OutputableBndrId name) => Outputable (AnnDecl name) where
 data AnnProvenance name = ValueAnnProvenance (Located name)
                         | TypeAnnProvenance (Located name)
                         | ModuleAnnProvenance
-  deriving (Data, Functor)
+deriving instance Functor     AnnProvenance
 deriving instance Foldable    AnnProvenance
 deriving instance Traversable AnnProvenance
+deriving instance (Data pass) => Data (AnnProvenance pass)
 
 annProvenanceName_maybe :: AnnProvenance name -> Maybe name
 annProvenanceName_maybe (ValueAnnProvenance (L _ name)) = Just name
@@ -2078,21 +2109,21 @@ pprAnnProvenance (TypeAnnProvenance (L _ name))
 -}
 
 -- | Located Role Annotation Declaration
-type LRoleAnnotDecl name = Located (RoleAnnotDecl name)
+type LRoleAnnotDecl pass = Located (RoleAnnotDecl pass)
 
 -- See #8185 for more info about why role annotations are
 -- top-level declarations
 -- | Role Annotation Declaration
-data RoleAnnotDecl name
-  = RoleAnnotDecl (Located name)         -- type constructor
+data RoleAnnotDecl pass
+  = RoleAnnotDecl (Located (IdP pass))   -- type constructor
                   [Located (Maybe Role)] -- optional annotations
       -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType',
       --           'ApiAnnotation.AnnRole'
 
       -- For details on above see note [Api annotations] in ApiAnnotation
-  deriving Data
+deriving instance (DataId pass) => Data (RoleAnnotDecl pass)
 
-instance OutputableBndr name => Outputable (RoleAnnotDecl name) where
+instance OutputableBndr (IdP pass) => Outputable (RoleAnnotDecl pass) where
   ppr (RoleAnnotDecl ltycon roles)
     = text "type role" <+> ppr ltycon <+>
       hsep (map (pp_role . unLoc) roles)
@@ -2100,5 +2131,5 @@ instance OutputableBndr name => Outputable (RoleAnnotDecl name) where
       pp_role Nothing  = underscore
       pp_role (Just r) = ppr r
 
-roleAnnotDeclName :: RoleAnnotDecl name -> name
+roleAnnotDeclName :: RoleAnnotDecl pass -> (IdP pass)
 roleAnnotDeclName (RoleAnnotDecl (L _ name) _) = name
index b76b3fb..e224431 100644 (file)
@@ -22,7 +22,6 @@ import BasicTypes
 import FastString
 import NameSet
 import Name
-import RdrName
 import DataCon
 import SrcLoc
 import HsSyn
@@ -47,7 +46,8 @@ showAstData b = showAstData' 0
     showAstData' n =
       generic
               `ext1Q` list
-              `extQ` string `extQ` fastString `extQ` srcSpan `extQ` lit
+              `extQ` string `extQ` fastString `extQ` srcSpan
+              `extQ` lit `extQ` litr `extQ` litt
               `extQ` bytestring
               `extQ` name `extQ` occName `extQ` moduleName `extQ` var
               `extQ` dataCon
@@ -78,13 +78,27 @@ showAstData b = showAstData' 0
                                 ++ "]"
 
             -- Eliminate word-size dependence
-            lit :: HsLit -> String
+            lit :: HsLit GhcPs -> String
             lit (HsWordPrim   s x) = numericLit "HsWord{64}Prim" x s
             lit (HsWord64Prim s x) = numericLit "HsWord{64}Prim" x s
             lit (HsIntPrim    s x) = numericLit "HsInt{64}Prim"  x s
             lit (HsInt64Prim  s x) = numericLit "HsInt{64}Prim"  x s
             lit l                  = generic l
 
+            litr :: HsLit GhcRn -> String
+            litr (HsWordPrim   s x) = numericLit "HsWord{64}Prim" x s
+            litr (HsWord64Prim s x) = numericLit "HsWord{64}Prim" x s
+            litr (HsIntPrim    s x) = numericLit "HsInt{64}Prim"  x s
+            litr (HsInt64Prim  s x) = numericLit "HsInt{64}Prim"  x s
+            litr l                  = generic l
+
+            litt :: HsLit GhcTc -> String
+            litt (HsWordPrim   s x) = numericLit "HsWord{64}Prim" x s
+            litt (HsWord64Prim s x) = numericLit "HsWord{64}Prim" x s
+            litt (HsIntPrim    s x) = numericLit "HsInt{64}Prim"  x s
+            litt (HsInt64Prim  s x) = numericLit "HsInt{64}Prim"  x s
+            litt l                  = generic l
+
             numericLit :: String -> Integer -> SourceText -> String
             numericLit tag x s = indent n ++ unwords [ "{" ++ tag
                                                      , generic x
@@ -114,15 +128,15 @@ showAstData b = showAstData' 0
             dataCon :: DataCon -> String
             dataCon    = ("{DataCon: "++) . (++"}") . showSDoc_ . ppr
 
-            bagRdrName:: Bag (Located (HsBind RdrName)) -> String
-            bagRdrName = ("{Bag(Located (HsBind RdrName)): "++) . (++"}")
+            bagRdrName:: Bag (Located (HsBind GhcPs)) -> String
+            bagRdrName = ("{Bag(Located (HsBind GhcPs)): "++) . (++"}")
                           . list . bagToList
 
-            bagName   :: Bag (Located (HsBind Name)) -> String
+            bagName   :: Bag (Located (HsBind GhcRn)) -> String
             bagName    = ("{Bag(Located (HsBind Name)): "++) . (++"}")
                            . list . bagToList
 
-            bagVar    :: Bag (Located (HsBind Var)) -> String
+            bagVar    :: Bag (Located (HsBind GhcTc)) -> String
             bagVar     = ("{Bag(Located (HsBind Var)): "++) . (++"}")
                            . list . bagToList
 
index c281e63..cfc9d17 100644 (file)
@@ -21,15 +21,14 @@ module HsExpr where
 import HsDecls
 import HsPat
 import HsLit
-import PlaceHolder ( PostTc,PostRn,DataId,DataIdPost,
-                     NameOrRdrName,OutputableBndrId )
+import PlaceHolder ( NameOrRdrName )
+import HsExtension
 import HsTypes
 import HsBinds
 
 -- others:
 import TcEvidence
 import CoreSyn
-import Var
 import DynFlags ( gopt, GeneralFlag(Opt_PrintExplicitCoercions) )
 import Name
 import NameSet
@@ -61,7 +60,7 @@ import qualified Language.Haskell.TH as TH (Q)
 -- * Expressions proper
 
 -- | Located Haskell Expression
-type LHsExpr id = Located (HsExpr id)
+type LHsExpr p = Located (HsExpr p)
   -- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnComma' when
   --   in a list
 
@@ -72,7 +71,7 @@ type LHsExpr id = Located (HsExpr id)
 --
 -- PostTcExpr is an evidence expression attached to the syntax tree by the
 -- type checker (c.f. postTcType).
-type PostTcExpr  = HsExpr Id
+type PostTcExpr  = HsExpr GhcTc
 
 -- | Post-Type checking Table
 --
@@ -81,7 +80,7 @@ type PostTcExpr  = HsExpr Id
 type PostTcTable = [(Name, PostTcExpr)]
 
 noPostTcExpr :: PostTcExpr
-noPostTcExpr = HsLit (HsString NoSourceText (fsLit "noPostTcExpr"))
+noPostTcExpr = HsLit (HsString noSourceText (fsLit "noPostTcExpr"))
 
 noPostTcTable :: PostTcTable
 noPostTcTable = []
@@ -105,33 +104,34 @@ noPostTcTable = []
 -- This could be defined using @PostRn@ and @PostTc@ and such, but it's
 -- harder to get it all to work out that way. ('noSyntaxExpr' is hard to
 -- write, for example.)
-data SyntaxExpr id = SyntaxExpr { syn_expr      :: HsExpr id
-                                , syn_arg_wraps :: [HsWrapper]
-                                , syn_res_wrap  :: HsWrapper }
-deriving instance (DataId id) => Data (SyntaxExpr id)
+data SyntaxExpr p = SyntaxExpr { syn_expr      :: HsExpr p
+                               , syn_arg_wraps :: [HsWrapper]
+                               , syn_res_wrap  :: HsWrapper }
+deriving instance (DataId p) => Data (SyntaxExpr p)
 
 -- | This is used for rebindable-syntax pieces that are too polymorphic
 -- for tcSyntaxOp (trS_fmap and the mzip in ParStmt)
-noExpr :: HsExpr id
-noExpr = HsLit (HsString (SourceText  "noExpr") (fsLit "noExpr"))
+noExpr :: SourceTextX p => HsExpr p
+noExpr = HsLit (HsString (sourceText  "noExpr") (fsLit "noExpr"))
 
-noSyntaxExpr :: SyntaxExpr id -- Before renaming, and sometimes after,
+noSyntaxExpr :: SourceTextX p => SyntaxExpr p
+                              -- Before renaming, and sometimes after,
                               -- (if the syntax slot makes no sense)
-noSyntaxExpr = SyntaxExpr { syn_expr      = HsLit (HsString NoSourceText
+noSyntaxExpr = SyntaxExpr { syn_expr      = HsLit (HsString noSourceText
                                                         (fsLit "noSyntaxExpr"))
                           , syn_arg_wraps = []
                           , syn_res_wrap  = WpHole }
 
 -- | Make a 'SyntaxExpr Name' (the "rn" is because this is used in the
 -- renamer), missing its HsWrappers.
-mkRnSyntaxExpr :: Name -> SyntaxExpr Name
+mkRnSyntaxExpr :: Name -> SyntaxExpr GhcRn
 mkRnSyntaxExpr name = SyntaxExpr { syn_expr      = HsVar $ noLoc name
                                  , syn_arg_wraps = []
                                  , syn_res_wrap  = WpHole }
   -- don't care about filling in syn_arg_wraps because we're clearly
   -- not past the typechecker
 
-instance (OutputableBndrId id) => Outputable (SyntaxExpr id) where
+instance (SourceTextX p, OutputableBndrId p) => Outputable (SyntaxExpr p) where
   ppr (SyntaxExpr { syn_expr      = expr
                   , syn_arg_wraps = arg_wraps
                   , syn_res_wrap  = res_wrap })
@@ -143,7 +143,7 @@ instance (OutputableBndrId id) => Outputable (SyntaxExpr id) where
       else ppr expr
 
 -- | Command Syntax Table (for Arrow syntax)
-type CmdSyntaxTable id = [(Name, HsExpr id)]
+type CmdSyntaxTable p = [(Name, HsExpr p)]
 -- See Note [CmdSyntaxTable]
 
 {-
@@ -273,8 +273,8 @@ information to use is the GlobalRdrEnv itself.
 -}
 
 -- | A Haskell expression.
-data HsExpr id
-  = HsVar     (Located id)   -- ^ Variable
+data HsExpr p
+  = HsVar     (Located (IdP p)) -- ^ Variable
 
                              -- See Note [Located RdrNames]
 
@@ -289,28 +289,29 @@ data HsExpr id
   | HsConLikeOut ConLike     -- ^ After typechecker only; must be different
                              -- HsVar for pretty printing
 
-  | HsRecFld (AmbiguousFieldOcc id) -- ^ Variable pointing to record selector
+  | HsRecFld (AmbiguousFieldOcc p) -- ^ Variable pointing to record selector
                                     -- Not in use after typechecking
 
-  | HsOverLabel (Maybe id) FastString
+  | HsOverLabel (Maybe (IdP p)) FastString
      -- ^ Overloaded label (Note [Overloaded labels] in GHC.OverloadedLabels)
      --   @Just id@ means @RebindableSyntax@ is in use, and gives the id of the
      --   in-scope 'fromLabel'.
      --   NB: Not in use after typechecking
 
   | HsIPVar   HsIPName       -- ^ Implicit parameter (not in use after typechecking)
-  | HsOverLit (HsOverLit id) -- ^ Overloaded literals
+  | HsOverLit (HsOverLit p)  -- ^ Overloaded literals
 
-  | HsLit     HsLit          -- ^ Simple (non-overloaded) literals
+  | HsLit     (HsLit p)      -- ^ Simple (non-overloaded) literals
 
-  | HsLam     (MatchGroup id (LHsExpr id)) -- ^ Lambda abstraction. Currently always a single match
+  | HsLam     (MatchGroup p (LHsExpr p))
+                       -- ^ Lambda abstraction. Currently always a single match
        --
        -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLam',
        --       'ApiAnnotation.AnnRarrow',
 
        -- For details on above see note [Api annotations] in ApiAnnotation
 
-  | HsLamCase (MatchGroup id (LHsExpr id)) -- ^ Lambda-case
+  | HsLamCase (MatchGroup p (LHsExpr p)) -- ^ Lambda-case
        --
        -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLam',
        --           'ApiAnnotation.AnnCase','ApiAnnotation.AnnOpen',
@@ -318,16 +319,17 @@ data HsExpr id
 
        -- For details on above see note [Api annotations] in ApiAnnotation
 
-  | HsApp     (LHsExpr id) (LHsExpr id) -- ^ Application
+  | HsApp     (LHsExpr p) (LHsExpr p) -- ^ Application
 
-  | HsAppType (LHsExpr id) (LHsWcType id) -- ^ Visible type application
+  | HsAppType (LHsExpr p) (LHsWcType p) -- ^ Visible type application
        --
        -- Explicit type argument; e.g  f @Int x y
        -- NB: Has wildcards, but no implicit quantification
        --
        -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnAt',
 
-  | HsAppTypeOut (LHsExpr id) (LHsWcType Name) -- just for pretty-printing
+  -- TODO:AZ: Sort out Name
+  | HsAppTypeOut (LHsExpr p) (LHsWcType GhcRn) -- just for pretty-printing
 
 
   -- | Operator applications:
@@ -336,10 +338,10 @@ data HsExpr id
   -- NB We need an expr for the operator in an OpApp/Section since
   -- the typechecker may need to apply the operator to a few types.
 
-  | OpApp       (LHsExpr id)    -- left operand
-                (LHsExpr id)    -- operator
-                (PostRn id Fixity) -- Renamer adds fixity; bottom until then
-                (LHsExpr id)    -- right operand
+  | OpApp       (LHsExpr p)       -- left operand
+                (LHsExpr p)       -- operator
+                (PostRn p Fixity) -- Renamer adds fixity; bottom until then
+                (LHsExpr p)       -- right operand
 
   -- | Negation operator. Contains the negated expression and the name
   -- of 'negate'
@@ -347,19 +349,19 @@ data HsExpr id
   --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnMinus'
 
   -- For details on above see note [Api annotations] in ApiAnnotation
-  | NegApp      (LHsExpr id)
-                (SyntaxExpr id)
+  | NegApp      (LHsExpr p)
+                (SyntaxExpr p)
 
   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'('@,
   --             'ApiAnnotation.AnnClose' @')'@
 
   -- For details on above see note [Api annotations] in ApiAnnotation
-  | HsPar       (LHsExpr id)    -- ^ Parenthesised expr; see Note [Parens in HsSyn]
+  | HsPar       (LHsExpr p)  -- ^ Parenthesised expr; see Note [Parens in HsSyn]
 
-  | SectionL    (LHsExpr id)    -- operand; see Note [Sections in HsSyn]
-                (LHsExpr id)    -- operator
-  | SectionR    (LHsExpr id)    -- operator; see Note [Sections in HsSyn]
-                (LHsExpr id)    -- operand
+  | SectionL    (LHsExpr p)    -- operand; see Note [Sections in HsSyn]
+                (LHsExpr p)    -- operator
+  | SectionR    (LHsExpr p)    -- operator; see Note [Sections in HsSyn]
+                (LHsExpr p)    -- operand
 
   -- | Used for explicit tuples and sections thereof
   --
@@ -368,7 +370,7 @@ data HsExpr id
 
   -- For details on above see note [Api annotations] in ApiAnnotation
   | ExplicitTuple
-        [LHsTupArg id]
+        [LHsTupArg p]
         Boxity
 
   -- | Used for unboxed sum types
@@ -381,16 +383,16 @@ data HsExpr id
   | ExplicitSum
           ConTag --  Alternative (one-based)
           Arity  --  Sum arity
-          (LHsExpr id)
-          (PostTc id [Type])   -- the type arguments
+          (LHsExpr p)
+          (PostTc p [Type])   -- the type arguments
 
   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnCase',
   --       'ApiAnnotation.AnnOf','ApiAnnotation.AnnOpen' @'{'@,
   --       'ApiAnnotation.AnnClose' @'}'@
 
   -- For details on above see note [Api annotations] in ApiAnnotation
-  | HsCase      (LHsExpr id)
-                (MatchGroup id (LHsExpr id))
+  | HsCase      (LHsExpr p)
+                (MatchGroup p (LHsExpr p))
 
   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnIf',
   --       'ApiAnnotation.AnnSemi',
@@ -398,12 +400,12 @@ data HsExpr id
   --       'ApiAnnotation.AnnElse',
 
   -- For details on above see note [Api annotations] in ApiAnnotation
-  | HsIf        (Maybe (SyntaxExpr id)) -- cond function
+  | HsIf        (Maybe (SyntaxExpr p)) -- cond function
                                         -- Nothing => use the built-in 'if'
                                         -- See Note [Rebindable if]
-                (LHsExpr id)    --  predicate
-                (LHsExpr id)    --  then part
-                (LHsExpr id)    --  else part
+                (LHsExpr p)    --  predicate
+                (LHsExpr p)    --  then part
+                (LHsExpr p)    --  else part
 
   -- | Multi-way if
   --
@@ -411,7 +413,7 @@ data HsExpr id
   --       'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose',
 
   -- For details on above see note [Api annotations] in ApiAnnotation
-  | HsMultiIf   (PostTc id Type) [LGRHS id (LHsExpr id)]
+  | HsMultiIf   (PostTc p Type) [LGRHS p (LHsExpr p)]
 
   -- | let(rec)
   --
@@ -420,8 +422,8 @@ data HsExpr id
   --       'ApiAnnotation.AnnClose' @'}'@,'ApiAnnotation.AnnIn'
 
   -- For details on above see note [Api annotations] in ApiAnnotation
-  | HsLet       (LHsLocalBinds id)
-                (LHsExpr  id)
+  | HsLet       (LHsLocalBinds p)
+                (LHsExpr  p)
 
   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDo',
   --             'ApiAnnotation.AnnOpen', 'ApiAnnotation.AnnSemi',
@@ -432,8 +434,8 @@ data HsExpr id
   | HsDo        (HsStmtContext Name)     -- The parameterisation is unimportant
                                          -- because in this context we never use
                                          -- the PatGuard or ParStmt variant
-                (Located [ExprLStmt id]) -- "do":one or more stmts
-                (PostTc id Type)         -- Type of the whole expression
+                (Located [ExprLStmt p]) -- "do":one or more stmts
+                (PostTc p Type)         -- Type of the whole expression
 
   -- | Syntactic list: [a,b,c,...]
   --
@@ -442,9 +444,10 @@ data HsExpr id
 
   -- For details on above see note [Api annotations] in ApiAnnotation
   | ExplicitList
-                (PostTc id Type)        -- Gives type of components of list
-                (Maybe (SyntaxExpr id)) -- For OverloadedLists, the fromListN witness
-                [LHsExpr id]
+                (PostTc p Type)        -- Gives type of components of list
+                (Maybe (SyntaxExpr p))
+                                   -- For OverloadedLists, the fromListN witness
+                [LHsExpr p]
 
   -- | Syntactic parallel array: [:e1, ..., en:]
   --
@@ -455,8 +458,8 @@ data HsExpr id
 
   -- For details on above see note [Api annotations] in ApiAnnotation
   | ExplicitPArr
-                (PostTc id Type)   -- type of elements of the parallel array
-                [LHsExpr id]
+                (PostTc p Type)   -- type of elements of the parallel array
+                [LHsExpr p]
 
   -- | Record construction
   --
@@ -465,11 +468,12 @@ data HsExpr id
 
   -- For details on above see note [Api annotations] in ApiAnnotation
   | RecordCon
-      { rcon_con_name :: Located id         -- The constructor name;
+      { rcon_con_name :: Located (IdP p)    -- The constructor name;
                                             --  not used after type checking
-      , rcon_con_like :: PostTc id ConLike  -- The data constructor or pattern synonym
+      , rcon_con_like :: PostTc p ConLike
+                                      -- The data constructor or pattern synonym
       , rcon_con_expr :: PostTcExpr         -- Instantiated constructor function
-      , rcon_flds     :: HsRecordBinds id } -- The fields
+      , rcon_flds     :: HsRecordBinds p }  -- The fields
 
   -- | Record update
   --
@@ -478,18 +482,18 @@ data HsExpr id
 
   -- For details on above see note [Api annotations] in ApiAnnotation
   | RecordUpd
-      { rupd_expr :: LHsExpr id
-      , rupd_flds :: [LHsRecUpdField id]
-      , rupd_cons :: PostTc id [ConLike]
+      { rupd_expr :: LHsExpr p
+      , rupd_flds :: [LHsRecUpdField p]
+      , rupd_cons :: PostTc p [ConLike]
                 -- Filled in by the type checker to the
                 -- _non-empty_ list of DataCons that have
                 -- all the upd'd fields
 
-      , rupd_in_tys  :: PostTc id [Type]  -- Argument types of *input* record type
-      , rupd_out_tys :: PostTc id [Type]  --              and  *output* record type
-                                          -- The original type can be reconstructed
-                                          -- with conLikeResTy
-      , rupd_wrap :: PostTc id HsWrapper  -- See note [Record Update HsWrapper]
+      , rupd_in_tys  :: PostTc p [Type] -- Argument types of *input* record type
+      , rupd_out_tys :: PostTc p [Type] --             and  *output* record type
+                                       -- The original type can be reconstructed
+                                       -- with conLikeResTy
+      , rupd_wrap :: PostTc p HsWrapper  -- See note [Record Update HsWrapper]
       }
   -- For a type family, the arg types are of the *instance* tycon,
   -- not the family tycon
@@ -500,12 +504,12 @@ data HsExpr id
 
   -- For details on above see note [Api annotations] in ApiAnnotation
   | ExprWithTySig
-                (LHsExpr id)
-                (LHsSigWcType id)
+                (LHsExpr p)
+                (LHsSigWcType p)
 
   | ExprWithTySigOut              -- Post typechecking
-                (LHsExpr id)
-                (LHsSigWcType Name)  -- Retain the signature,
+                (LHsExpr p)
+                (LHsSigWcType GhcRn)  -- Retain the signature,
                                      -- as HsSigType Name, for
                                      -- round-tripping purposes
 
@@ -518,8 +522,9 @@ data HsExpr id
   -- For details on above see note [Api annotations] in ApiAnnotation
   | ArithSeq
                 PostTcExpr
-                (Maybe (SyntaxExpr id))   -- For OverloadedLists, the fromList witness
-                (ArithSeqInfo id)
+                (Maybe (SyntaxExpr p))
+                                  -- For OverloadedLists, the fromList witness
+                (ArithSeqInfo p)
 
   -- | Arithmetic sequence for parallel array
   --
@@ -533,7 +538,7 @@ data HsExpr id
   -- For details on above see note [Api annotations] in ApiAnnotation
   | PArrSeq
                 PostTcExpr
-                (ArithSeqInfo id)
+                (ArithSeqInfo p)
 
   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'{-\# SCC'@,
   --             'ApiAnnotation.AnnVal' or 'ApiAnnotation.AnnValStr',
@@ -542,7 +547,7 @@ data HsExpr id
   -- For details on above see note [Api annotations] in ApiAnnotation
   | HsSCC       SourceText            -- Note [Pragma source text] in BasicTypes
                 StringLiteral         -- "set cost centre" SCC pragma
-                (LHsExpr id)          -- expr whose cost is to be measured
+                (LHsExpr p)           -- expr whose cost is to be measured
 
   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'{-\# CORE'@,
   --             'ApiAnnotation.AnnVal', 'ApiAnnotation.AnnClose' @'\#-}'@
@@ -550,7 +555,7 @@ data HsExpr id
   -- For details on above see note [Api annotations] in ApiAnnotation
   | HsCoreAnn   SourceText            -- Note [Pragma source text] in BasicTypes
                 StringLiteral         -- hdaume: core annotation
-                (LHsExpr id)
+                (LHsExpr p)
 
   -----------------------------------------------------------
   -- MetaHaskell Extensions
@@ -560,16 +565,16 @@ data HsExpr id
   --         'ApiAnnotation.AnnClose','ApiAnnotation.AnnCloseQ'
 
   -- For details on above see note [Api annotations] in ApiAnnotation
-  | HsBracket    (HsBracket id)
+  | HsBracket    (HsBracket p)
 
     -- See Note [Pending Splices]
   | HsRnBracketOut
-      (HsBracket Name)     -- Output of the renamer is the *original* renamed
+      (HsBracket GhcRn)    -- Output of the renamer is the *original* renamed
                            -- expression, plus
       [PendingRnSplice]    -- _renamed_ splices to be type checked
 
   | HsTcBracketOut
-      (HsBracket Name)     -- Output of the type checker is the *original*
+      (HsBracket GhcRn)    -- Output of the type checker is the *original*
                            -- renamed expression, plus
       [PendingTcSplice]    -- _typechecked_ splices to be
                            -- pasted back in by the desugarer
@@ -578,7 +583,7 @@ data HsExpr id
   --         'ApiAnnotation.AnnClose'
 
   -- For details on above see note [Api annotations] in ApiAnnotation
-  | HsSpliceE  (HsSplice id)
+  | HsSpliceE  (HsSplice p)
 
   -----------------------------------------------------------
   -- Arrow notation extension
@@ -589,17 +594,17 @@ data HsExpr id
   --          'ApiAnnotation.AnnRarrow'
 
   -- For details on above see note [Api annotations] in ApiAnnotation
-  | HsProc      (LPat id)               -- arrow abstraction, proc
-                (LHsCmdTop id)          -- body of the abstraction
-                                        -- always has an empty stack
+  | HsProc      (LPat p)               -- arrow abstraction, proc
+                (LHsCmdTop p)          -- body of the abstraction
+                                       -- always has an empty stack
 
   ---------------------------------------
   -- static pointers extension
   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnStatic',
 
   -- For details on above see note [Api annotations] in ApiAnnotation
-  | HsStatic (PostRn id NameSet) -- Free variables of the body
-             (LHsExpr id)        -- Body
+  | HsStatic (PostRn p NameSet) -- Free variables of the body
+             (LHsExpr p)        -- Body
 
   ---------------------------------------
   -- The following are commands, not expressions proper
@@ -612,37 +617,37 @@ data HsExpr id
 
   -- For details on above see note [Api annotations] in ApiAnnotation
   | HsArrApp             -- Arrow tail, or arrow application (f -< arg)
-        (LHsExpr id)     -- arrow expression, f
-        (LHsExpr id)     -- input expression, arg
-        (PostTc id Type) -- type of the arrow expressions f,
-                         -- of the form a t t', where arg :: t
-        HsArrAppType     -- higher-order (-<<) or first-order (-<)
-        Bool             -- True => right-to-left (f -< arg)
-                         -- False => left-to-right (arg >- f)
+        (LHsExpr p)     -- arrow expression, f
+        (LHsExpr p)     -- input expression, arg
+        (PostTc p Type) -- type of the arrow expressions f,
+                        -- of the form a t t', where arg :: t
+        HsArrAppType    -- higher-order (-<<) or first-order (-<)
+        Bool            -- True => right-to-left (f -< arg)
+                        -- False => left-to-right (arg >- f)
 
   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpenB' @'(|'@,
   --         'ApiAnnotation.AnnCloseB' @'|)'@
 
   -- For details on above see note [Api annotations] in ApiAnnotation
   | HsArrForm            -- Command formation,  (| e cmd1 .. cmdn |)
-        (LHsExpr id)     -- the operator
+        (LHsExpr p)      -- the operator
                          -- after type-checking, a type abstraction to be
                          -- applied to the type of the local environment tuple
         (Maybe Fixity)   -- fixity (filled in by the renamer), for forms that
                          -- were converted from OpApp's by the renamer
-        [LHsCmdTop id]   -- argument commands
+        [LHsCmdTop p]    -- argument commands
 
   ---------------------------------------
   -- Haskell program coverage (Hpc) Support
 
   | HsTick
-     (Tickish id)
-     (LHsExpr id)                       -- sub-expression
+     (Tickish (IdP p))
+     (LHsExpr p)                       -- sub-expression
 
   | HsBinTick
      Int                                -- module-local tick number for True
      Int                                -- module-local tick number for False
-     (LHsExpr id)                       -- sub-expression
+     (LHsExpr p)                        -- sub-expression
 
   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
   --       'ApiAnnotation.AnnOpen' @'{-\# GENERATED'@,
@@ -661,7 +666,7 @@ data HsExpr id
      ((SourceText,SourceText),(SourceText,SourceText))
         -- Source text for the four integers used in the span.
         -- See note [Pragma source text] in BasicTypes
-     (LHsExpr id)
+     (LHsExpr p)
 
   ---------------------------------------
   -- These constructors only appear temporarily in the parser.
@@ -672,19 +677,19 @@ data HsExpr id
   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnAt'
 
   -- For details on above see note [Api annotations] in ApiAnnotation
-  | EAsPat      (Located id) -- as pattern
-                (LHsExpr id)
+  | EAsPat      (Located (IdP p)) -- as pattern
+                (LHsExpr p)
 
   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnRarrow'
 
   -- For details on above see note [Api annotations] in ApiAnnotation
-  | EViewPat    (LHsExpr id) -- view pattern
-                (LHsExpr id)
+  | EViewPat    (LHsExpr p) -- view pattern
+                (LHsExpr p)
 
   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnTilde'
 
   -- For details on above see note [Api annotations] in ApiAnnotation
-  | ELazyPat    (LHsExpr id) -- ~ pattern
+  | ELazyPat    (LHsExpr p) -- ~ pattern
 
 
   ---------------------------------------
@@ -694,9 +699,9 @@ data HsExpr id
   -- is maintained by HsUtils.mkHsWrap.
 
   |  HsWrap     HsWrapper    -- TRANSLATION
-                (HsExpr id)
+                (HsExpr p)
 
-deriving instance (DataId id) => Data (HsExpr id)
+deriving instance (DataId p) => Data (HsExpr p)
 
 -- | Located Haskell Tuple Argument
 --
@@ -791,16 +796,16 @@ RenamedSource that the API Annotations cannot be used directly with
 RenamedSource, so this allows a simple mapping to be used based on the location.
 -}
 
-instance (OutputableBndrId id) => Outputable (HsExpr id) where
+instance (SourceTextX p, OutputableBndrId p) => Outputable (HsExpr p) where
     ppr expr = pprExpr expr
 
 -----------------------
 -- pprExpr, pprLExpr, pprBinds call pprDeeper;
 -- the underscore versions do not
-pprLExpr :: (OutputableBndrId id) => LHsExpr id -> SDoc
+pprLExpr :: (SourceTextX p, OutputableBndrId p) => LHsExpr p -> SDoc
 pprLExpr (L _ e) = pprExpr e
 
-pprExpr :: (OutputableBndrId id) => HsExpr id -> SDoc
+pprExpr :: (SourceTextX p, OutputableBndrId p) => HsExpr p -> SDoc
 pprExpr e | isAtomicHsExpr e || isQuietHsExpr e =            ppr_expr e
           | otherwise                           = pprDeeper (ppr_expr e)
 
@@ -816,15 +821,16 @@ isQuietHsExpr (HsAppTypeOut _ _) = True
 isQuietHsExpr (OpApp _ _ _ _)    = True
 isQuietHsExpr _ = False
 
-pprBinds :: (OutputableBndrId idL, OutputableBndrId idR)
+pprBinds :: (SourceTextX idL, SourceTextX idR,
+             OutputableBndrId idL, OutputableBndrId idR)
          => HsLocalBindsLR idL idR -> SDoc
 pprBinds b = pprDeeper (ppr b)
 
 -----------------------
-ppr_lexpr :: (OutputableBndrId id) => LHsExpr id -> SDoc
+ppr_lexpr :: (SourceTextX p, OutputableBndrId p) => LHsExpr p -> SDoc
 ppr_lexpr e = ppr_expr (unLoc e)
 
-ppr_expr :: forall id. (OutputableBndrId id) => HsExpr id -> SDoc
+ppr_expr :: forall p. (SourceTextX p, OutputableBndrId p) => HsExpr p -> SDoc
 ppr_expr (HsVar (L _ v))  = pprPrefixOcc v
 ppr_expr (HsUnboundVar uv)= pprPrefixOcc (unboundVarOcc uv)
 ppr_expr (HsConLikeOut c) = pprPrefixOcc c
@@ -1042,10 +1048,11 @@ ppr_expr (HsRecFld f) = ppr f
 -- We must tiresomely make the "id" parameter to the LHsWcType existential
 -- because it's different in the HsAppType case and the HsAppTypeOut case
 -- | Located Haskell Wildcard Type Expression
-data LHsWcTypeX = forall id. (OutputableBndrId id) => LHsWcTypeX (LHsWcType id)
+data LHsWcTypeX = forall p. (SourceTextX p, OutputableBndrId p)
+                       => LHsWcTypeX (LHsWcType p)
 
-ppr_apps :: (OutputableBndrId id) => HsExpr id
-         -> [Either (LHsExpr id) LHsWcTypeX]
+ppr_apps :: (SourceTextX p, OutputableBndrId p) => HsExpr p
+         -> [Either (LHsExpr p) LHsWcTypeX]
          -> SDoc
 ppr_apps (HsApp (L _ fun) arg)        args
   = ppr_apps fun (Left arg : args)
@@ -1075,16 +1082,16 @@ fixities should do the job, except in debug mode (-dppr-debug) so we
 can see the structure of the parse tree.
 -}
 
-pprDebugParendExpr :: (OutputableBndrId id) => LHsExpr id -> SDoc
+pprDebugParendExpr :: (SourceTextX p, OutputableBndrId p) => LHsExpr p -> SDoc
 pprDebugParendExpr expr
   = getPprStyle (\sty ->
     if debugStyle sty then pprParendLExpr expr
                       else pprLExpr      expr)
 
-pprParendLExpr :: (OutputableBndrId id) => LHsExpr id -> SDoc
+pprParendLExpr :: (SourceTextX p, OutputableBndrId p) => LHsExpr p -> SDoc
 pprParendLExpr (L _ e) = pprParendExpr e
 
-pprParendExpr :: (OutputableBndrId id) => HsExpr id -> SDoc
+pprParendExpr :: (SourceTextX p, OutputableBndrId p) => HsExpr p -> SDoc
 pprParendExpr expr
   | hsExprNeedsParens expr = parens (pprExpr expr)
   | otherwise              = pprExpr expr
@@ -1245,26 +1252,26 @@ argument of a command-forming operator.
 -}
 
 -- | Located Haskell Top-level Command
-type LHsCmdTop id = Located (HsCmdTop id)
+type LHsCmdTop p = Located (HsCmdTop p)
 
 -- | Haskell Top-level Command
-data HsCmdTop id
-  = HsCmdTop (LHsCmd id)
-             (PostTc id Type)   -- Nested tuple of inputs on the command's stack
-             (PostTc id Type)   -- return type of the command
-             (CmdSyntaxTable id) -- See Note [CmdSyntaxTable]
-deriving instance (DataId id) => Data (HsCmdTop id)
-
-instance (OutputableBndrId id) => Outputable (HsCmd id) where
+data HsCmdTop p
+  = HsCmdTop (LHsCmd p)
+             (PostTc p Type)    -- Nested tuple of inputs on the command's stack
+             (PostTc p Type)    -- return type of the command
+             (CmdSyntaxTable p) -- See Note [CmdSyntaxTable]
+deriving instance (DataId p) => Data (HsCmdTop p)
+
+instance (SourceTextX p, OutputableBndrId p) => Outputable (HsCmd p) where
     ppr cmd = pprCmd cmd
 
 -----------------------
 -- pprCmd and pprLCmd call pprDeeper;
 -- the underscore versions do not
-pprLCmd :: (OutputableBndrId id) => LHsCmd id -> SDoc
+pprLCmd :: (SourceTextX p, OutputableBndrId p) => LHsCmd p -> SDoc
 pprLCmd (L _ c) = pprCmd c
 
-pprCmd :: (OutputableBndrId id) => HsCmd id -> SDoc
+pprCmd :: (SourceTextX p, OutputableBndrId p) => HsCmd p -> SDoc
 pprCmd c | isQuietHsCmd c =            ppr_cmd c
          | otherwise      = pprDeeper (ppr_cmd c)
 
@@ -1278,10 +1285,10 @@ isQuietHsCmd (HsCmdApp _ _) = True
 isQuietHsCmd _ = False
 
 -----------------------
-ppr_lcmd :: (OutputableBndrId id) => LHsCmd id -> SDoc
+ppr_lcmd :: (SourceTextX p, OutputableBndrId p) => LHsCmd p -> SDoc
 ppr_lcmd c = ppr_cmd (unLoc c)
 
-ppr_cmd :: forall id. (OutputableBndrId id) => HsCmd id -> SDoc
+ppr_cmd :: forall p. (SourceTextX p, OutputableBndrId p) => HsCmd p -> SDoc
 ppr_cmd (HsCmdPar c) = parens (ppr_lcmd c)
 
 ppr_cmd (HsCmdApp c e)
@@ -1342,11 +1349,11 @@ ppr_cmd (HsCmdArrForm op _ _ args)
   = hang (text "(|" <> ppr_lexpr op)
          4 (sep (map (pprCmdArg.unLoc) args) <> text "|)")
 
-pprCmdArg :: (OutputableBndrId id) => HsCmdTop id -> SDoc
+pprCmdArg :: (SourceTextX p, OutputableBndrId p) => HsCmdTop p -> SDoc
 pprCmdArg (HsCmdTop cmd _ _ _)
   = ppr_lcmd cmd
 
-instance (OutputableBndrId id) => Outputable (HsCmdTop id) where
+instance (SourceTextX p, OutputableBndrId p) => Outputable (HsCmdTop p) where
     ppr = pprCmdArg
 
 {-
@@ -1358,7 +1365,7 @@ instance (OutputableBndrId id) => Outputable (HsCmdTop id) where
 -}
 
 -- | Haskell Record Bindings
-type HsRecordBinds id = HsRecFields id (LHsExpr id)
+type HsRecordBinds p = HsRecFields p (LHsExpr p)
 
 {-
 ************************************************************************
@@ -1382,15 +1389,15 @@ a function defined by pattern matching must have the same number of
 patterns in each equation.
 -}
 
-data MatchGroup id body
-  = MG { mg_alts    :: Located [LMatch id body]  -- The alternatives
-       , mg_arg_tys :: [PostTc id Type]  -- Types of the arguments, t1..tn
-       , mg_res_ty  :: PostTc id Type    -- Type of the result, tr
+data MatchGroup p body
+  = MG { mg_alts    :: Located [LMatch p body]  -- The alternatives
+       , mg_arg_tys :: [PostTc p Type]  -- Types of the arguments, t1..tn
+       , mg_res_ty  :: PostTc p Type    -- Type of the result, tr
        , mg_origin  :: Origin }
      -- The type is the type of the entire group
      --      t1 -> ... -> tn -> tr
      -- where there are n patterns
-deriving instance (Data body,DataId id) => Data (MatchGroup id body)
+deriving instance (Data body,DataId p) => Data (MatchGroup p body)
 
 -- | Located Match
 type LMatch id body = Located (Match id body)
@@ -1398,20 +1405,20 @@ type LMatch id body = Located (Match id body)
 --   list
 
 -- For details on above see note [Api annotations] in ApiAnnotation
-data Match id body
+data Match p body
   = Match {
-        m_ctxt :: HsMatchContext (NameOrRdrName id),
+        m_ctxt :: HsMatchContext (NameOrRdrName (IdP p)),
           -- See note [m_ctxt in Match]
-        m_pats :: [LPat id], -- The patterns
-        m_type :: (Maybe (LHsType id)),
+        m_pats :: [LPat p], -- The patterns
+        m_type :: (Maybe (LHsType p)),
                                  -- A type signature for the result of the match
                                  -- Nothing after typechecking
                                  -- NB: No longer supported
-        m_grhss :: (GRHSs id body)
+        m_grhss :: (GRHSs p body)
   }
-deriving instance (Data body,DataId id) => Data (Match id body)
+deriving instance (Data body,DataId p) => Data (Match p body)
 
-instance (OutputableBndrId idR, Outputable body)
+instance (SourceTextX idR, OutputableBndrId idR, Outputable body)
             => Outputable (Match idR body) where
   ppr = pprMatch
 
@@ -1489,12 +1496,12 @@ hsLMatchPats (L _ (Match _ pats _ _)) = pats
 --        'ApiAnnotation.AnnRarrow','ApiAnnotation.AnnSemi'
 
 -- For details on above see note [Api annotations] in ApiAnnotation
-data GRHSs id body
+data GRHSs p body
   = GRHSs {
-      grhssGRHSs :: [LGRHS id body],      -- ^ Guarded RHSs
-      grhssLocalBinds :: LHsLocalBinds id -- ^ The where clause
+      grhssGRHSs :: [LGRHS p body],      -- ^ Guarded RHSs
+      grhssLocalBinds :: LHsLocalBinds p -- ^ The where clause
     }
-deriving instance (Data body,DataId id) => Data (GRHSs id body)
+deriving instance (Data body,DataId p) => Data (GRHSs p body)
 
 -- | Located Guarded Right-Hand Side
 type LGRHS id body = Located (GRHS id body)
@@ -1506,26 +1513,28 @@ deriving instance (Data body,DataId id) => Data (GRHS id body)
 
 -- We know the list must have at least one @Match@ in it.
 
-pprMatches :: (OutputableBndrId idR, Outputable body)
+pprMatches :: (SourceTextX idR, OutputableBndrId idR, Outputable body)
            => MatchGroup idR body -> SDoc
 pprMatches MG { mg_alts = matches }
     = vcat (map pprMatch (map unLoc (unLoc matches)))
       -- Don't print the type; it's only a place-holder before typechecking
 
 -- Exported to HsBinds, which can't see the defn of HsMatchContext
-pprFunBind :: (OutputableBndrId idR, Outputable body)
+pprFunBind :: (SourceTextX idR, OutputableBndrId idR, Outputable body)
            => MatchGroup idR body -> SDoc
 pprFunBind matches = pprMatches matches
 
 -- Exported to HsBinds, which can't see the defn of HsMatchContext
-pprPatBind :: forall bndr id body. (OutputableBndrId bndr,
-                                    OutputableBndrId id,
-                                    Outputable body)
-           => LPat bndr -> GRHSs id body -> SDoc
+pprPatBind :: forall bndr p body. (SourceTextX p, SourceTextX bndr,
+                                   OutputableBndrId bndr,
+                                   OutputableBndrId p,
+                                   Outputable body)
+           => LPat bndr -> GRHSs p body -> SDoc
 pprPatBind pat (grhss)
- = sep [ppr pat, nest 2 (pprGRHSs (PatBindRhs :: HsMatchContext id) grhss)]
+ = sep [ppr pat, nest 2 (pprGRHSs (PatBindRhs :: HsMatchContext (IdP p)) grhss)]
 
-pprMatch :: (OutputableBndrId idR, Outputable body) => Match idR body -> SDoc
+pprMatch :: (SourceTextX idR, OutputableBndrId idR, Outputable body)
+         => Match idR body -> SDoc
 pprMatch match
   = sep [ sep (herald : map (nest 2 . pprParendLPat) other_pats)
         , nest 2 ppr_maybe_ty
@@ -1560,7 +1569,7 @@ pprMatch match
                         Nothing -> empty
 
 
-pprGRHSs :: (OutputableBndrId idR, Outputable body)
+pprGRHSs :: (SourceTextX idR, OutputableBndrId idR, Outputable body)
          => HsMatchContext idL -> GRHSs idR body -> SDoc
 pprGRHSs ctxt (GRHSs grhss (L _ binds))
   = vcat (map (pprGRHS ctxt . unLoc) grhss)
@@ -1569,7 +1578,7 @@ pprGRHSs ctxt (GRHSs grhss (L _ binds))
  $$ ppUnless (eqEmptyLocalBinds binds)
       (text "where" $$ nest 4 (pprBinds binds))
 
-pprGRHS :: (OutputableBndrId idR, Outputable body)
+pprGRHS :: (SourceTextX idR, OutputableBndrId idR, Outputable body)
         => HsMatchContext idL -> GRHS idR body -> SDoc
 pprGRHS ctxt (GRHS [] body)
  =  pp_rhs ctxt body
@@ -1695,7 +1704,7 @@ data StmtLR idL idR body -- body should always be (LHs**** idR)
       trS_stmts :: [ExprLStmt idL],   -- Stmts to the *left* of the 'group'
                                       -- which generates the tuples to be grouped
 
-      trS_bndrs :: [(idR, idR)],      -- See Note [TransStmt binder map]
+      trS_bndrs :: [(IdP idR, IdP idR)], -- See Note [TransStmt binder map]
 
       trS_using :: LHsExpr idR,
       trS_by :: Maybe (LHsExpr idR),  -- "by e" (optional)
@@ -1719,12 +1728,14 @@ data StmtLR idL idR body -- body should always be (LHs**** idR)
      { recS_stmts :: [LStmtLR idL idR body]
 
         -- The next two fields are only valid after renaming
-     , recS_later_ids :: [idR] -- The ids are a subset of the variables bound by the
-                               -- stmts that are used in stmts that follow the RecStmt
-
-     , recS_rec_ids :: [idR]   -- Ditto, but these variables are the "recursive" ones,
-                               -- that are used before they are bound in the stmts of
-                               -- the RecStmt.
+     , recS_later_ids :: [IdP idR]
+                         -- The ids are a subset of the variables bound by the
+                         -- stmts that are used in stmts that follow the RecStmt
+
+     , recS_rec_ids :: [IdP idR]
+                         -- Ditto, but these variables are the "recursive" ones,
+                         -- that are used before they are bound in the stmts of
+                         -- the RecStmt.
         -- An Id can be in both groups
         -- Both sets of Ids are (now) treated monomorphically
         -- See Note [How RecStmt works] for why they are separate
@@ -1763,7 +1774,7 @@ data TransForm   -- The 'f' below is the 'using' function, 'e' is the by functio
 data ParStmtBlock idL idR
   = ParStmtBlock
         [ExprLStmt idL]
-        [idR]              -- The variables to be returned
+        [IdP idR]          -- The variables to be returned
         (SyntaxExpr idR)   -- The return operator
 deriving instance (DataId idL, DataId idR) => Data (ParStmtBlock idL idR)
 
@@ -1915,14 +1926,17 @@ In any other context than 'MonadComp', the fields for most of these
 'SyntaxExpr's stay bottom.
 -}
 
-instance (OutputableBndrId idL) => Outputable (ParStmtBlock idL idR) where
+instance (SourceTextX idL, OutputableBndrId idL)
+       => Outputable (ParStmtBlock idL idR) where
   ppr (ParStmtBlock stmts _ _) = interpp'SP stmts
 
-instance (OutputableBndrId idL, OutputableBndrId idR, Outputable body)
+instance (SourceTextX idL, SourceTextX idR,
+          OutputableBndrId idL, OutputableBndrId idR, Outputable body)
          => Outputable (StmtLR idL idR body) where
     ppr stmt = pprStmt stmt
 
-pprStmt :: forall idL idR body . (OutputableBndrId idL, OutputableBndrId idR,
+pprStmt :: forall idL idR body . (SourceTextX idL, SourceTextX idR,
+                                  OutputableBndrId idL, OutputableBndrId idR,
                                   Outputable body)
         => (StmtLR idL idR body) -> SDoc
 pprStmt (LastStmt expr ret_stripped _)
@@ -1986,8 +2000,8 @@ pprStmt (ApplicativeStmt args mb_join _)
                 (stmts ++ [noLoc (LastStmt (noLoc return) False noSyntaxExpr)]))
            (error "pprStmt"))
 
-pprTransformStmt :: (OutputableBndrId id)
-                 => [id] -> LHsExpr id -> Maybe (LHsExpr id) -> SDoc
+pprTransformStmt :: (SourceTextX p, OutputableBndrId p)
+                 => [IdP p] -> LHsExpr p -> Maybe (LHsExpr p) -> SDoc
 pprTransformStmt bndrs using by
   = sep [ text "then" <+> ifPprDebug (braces (ppr bndrs))
         , nest 2 (ppr using)
@@ -2003,8 +2017,8 @@ pprBy :: Outputable body => Maybe body -> SDoc
 pprBy Nothing  = empty
 pprBy (Just e) = text "by" <+> ppr e
 
-pprDo :: (OutputableBndrId id, Outputable body)
-      => HsStmtContext any -> [LStmt id body] -> SDoc
+pprDo :: (SourceTextX p, OutputableBndrId p, Outputable body)
+      => HsStmtContext any -> [LStmt p body] -> SDoc
 p