summaryrefslogtreecommitdiff
path: root/compiler/hsSyn
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/hsSyn')
-rw-r--r--compiler/hsSyn/Convert.hs149
-rw-r--r--compiler/hsSyn/HsBinds.hs121
-rw-r--r--compiler/hsSyn/HsDecls.hs531
-rw-r--r--compiler/hsSyn/HsDumpAst.hs28
-rw-r--r--compiler/hsSyn/HsExpr.hs461
-rw-r--r--compiler/hsSyn/HsExpr.hs-boot40
-rw-r--r--compiler/hsSyn/HsExtension.hs289
-rw-r--r--compiler/hsSyn/HsImpExp.hs37
-rw-r--r--compiler/hsSyn/HsLit.hs132
-rw-r--r--compiler/hsSyn/HsPat.hs183
-rw-r--r--compiler/hsSyn/HsPat.hs-boot6
-rw-r--r--compiler/hsSyn/HsSyn.hs7
-rw-r--r--compiler/hsSyn/HsTypes.hs392
-rw-r--r--compiler/hsSyn/HsUtils.hs297
-rw-r--r--compiler/hsSyn/PlaceHolder.hs50
15 files changed, 1556 insertions, 1167 deletions
diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs
index e64c4eaed5..5ded8bcde3 100644
--- a/compiler/hsSyn/Convert.hs
+++ b/compiler/hsSyn/Convert.hs
@@ -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]
diff --git a/compiler/hsSyn/HsBinds.hs b/compiler/hsSyn/HsBinds.hs
index b39e25a2c7..b760cb3a88 100644
--- a/compiler/hsSyn/HsBinds.hs
+++ b/compiler/hsSyn/HsBinds.hs
@@ -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)
diff --git a/compiler/hsSyn/HsDecls.hs b/compiler/hsSyn/HsDecls.hs
index 7fcc3b8699..8b7d9c6a40 100644
--- a/compiler/hsSyn/HsDecls.hs
+++ b/compiler/hsSyn/HsDecls.hs
@@ -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
diff --git a/compiler/hsSyn/HsDumpAst.hs b/compiler/hsSyn/HsDumpAst.hs
index b76b3fbd94..e2244312d0 100644
--- a/compiler/hsSyn/HsDumpAst.hs
+++ b/compiler/hsSyn/HsDumpAst.hs
@@ -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
diff --git a/compiler/hsSyn/HsExpr.hs b/compiler/hsSyn/HsExpr.hs
index c281e6361c..cfc9d177bd 100644
--- a/compiler/hsSyn/HsExpr.hs
+++ b/compiler/hsSyn/HsExpr.hs
@@ -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
pprDo DoExpr stmts = text "do" <+> ppr_do_stmts stmts
pprDo GhciStmtCtxt stmts = text "do" <+> ppr_do_stmts stmts
pprDo ArrowExpr stmts = text "do" <+> ppr_do_stmts stmts
@@ -2014,12 +2028,14 @@ pprDo PArrComp stmts = paBrackets $ pprComp stmts
pprDo MonadComp stmts = brackets $ pprComp stmts
pprDo _ _ = panic "pprDo" -- PatGuard, ParStmtCxt
-ppr_do_stmts :: (OutputableBndrId idL, OutputableBndrId idR, Outputable body)
+ppr_do_stmts :: (SourceTextX idL, SourceTextX idR,
+ OutputableBndrId idL, OutputableBndrId idR, Outputable body)
=> [LStmtLR idL idR body] -> SDoc
-- Print a bunch of do stmts
ppr_do_stmts stmts = pprDeeperList vcat (map ppr stmts)
-pprComp :: (OutputableBndrId id, Outputable body) => [LStmt id body] -> SDoc
+pprComp :: (SourceTextX p, OutputableBndrId p, Outputable body)
+ => [LStmt p body] -> SDoc
pprComp quals -- Prints: body | qual1, ..., qualn
| Just (initStmts, L _ (LastStmt body _ _)) <- snocView quals
= if null initStmts
@@ -2033,7 +2049,8 @@ pprComp quals -- Prints: body | qual1, ..., qualn
| otherwise
= pprPanic "pprComp" (pprQuals quals)
-pprQuals :: (OutputableBndrId id, Outputable body) => [LStmt id body] -> SDoc
+pprQuals :: (SourceTextX p, OutputableBndrId p, Outputable body)
+ => [LStmt p body] -> SDoc
-- Show list comprehension qualifiers separated by commas
pprQuals quals = interpp'SP quals
@@ -2049,17 +2066,17 @@ pprQuals quals = interpp'SP quals
data HsSplice id
= HsTypedSplice -- $$z or $$(f 4)
SpliceDecoration -- Whether $$( ) variant found, for pretty printing
- id -- A unique name to identify this splice point
+ (IdP id) -- A unique name to identify this splice point
(LHsExpr id) -- See Note [Pending Splices]
| HsUntypedSplice -- $z or $(f 4)
SpliceDecoration -- Whether $( ) variant found, for pretty printing
- id -- A unique name to identify this splice point
+ (IdP id) -- A unique name to identify this splice point
(LHsExpr id) -- See Note [Pending Splices]
| HsQuasiQuote -- See Note [Quasi-quote overview] in TcSplice
- id -- Splice point
- id -- Quoter
+ (IdP id) -- Splice point
+ (IdP id) -- Quoter
SrcSpan -- The span of the enclosed string
FastString -- The enclosed string
@@ -2120,7 +2137,8 @@ type SplicePointName = Name
-- | Pending Renamer Splice
data PendingRnSplice
- = PendingRnSplice UntypedSpliceFlavour SplicePointName (LHsExpr Name)
+ -- AZ:TODO: The hard-coded GhcRn feels wrong. How to force the PostRn?
+ = PendingRnSplice UntypedSpliceFlavour SplicePointName (LHsExpr GhcRn)
deriving Data
data UntypedSpliceFlavour
@@ -2132,7 +2150,8 @@ data UntypedSpliceFlavour
-- | Pending Type-checker Splice
data PendingTcSplice
- = PendingTcSplice SplicePointName (LHsExpr Id)
+ -- AZ:TODO: The hard-coded GhcTc feels wrong. How to force the PostTc?
+ = PendingTcSplice SplicePointName (LHsExpr GhcTc)
deriving Data
@@ -2200,29 +2219,30 @@ splices. In contrast, when pretty printing the output of the type checker, we
sense, although I hate to add another constructor to HsExpr.
-}
-instance (OutputableBndrId id) => Outputable (HsSplicedThing id) where
+instance (SourceTextX p, OutputableBndrId p)
+ => Outputable (HsSplicedThing p) where
ppr (HsSplicedExpr e) = ppr_expr e
ppr (HsSplicedTy t) = ppr t
ppr (HsSplicedPat p) = ppr p
-instance (OutputableBndrId id) => Outputable (HsSplice id) where
+instance (SourceTextX p, OutputableBndrId p) => Outputable (HsSplice p) where
ppr s = pprSplice s
-pprPendingSplice :: (OutputableBndrId id)
- => SplicePointName -> LHsExpr id -> SDoc
+pprPendingSplice :: (SourceTextX p, OutputableBndrId p)
+ => SplicePointName -> LHsExpr p -> SDoc
pprPendingSplice n e = angleBrackets (ppr n <> comma <+> ppr e)
-pprSpliceDecl :: (OutputableBndrId id)
- => HsSplice id -> SpliceExplicitFlag -> SDoc
+pprSpliceDecl :: (SourceTextX p, OutputableBndrId p)
+ => HsSplice p -> SpliceExplicitFlag -> SDoc
pprSpliceDecl e@HsQuasiQuote{} _ = pprSplice e
pprSpliceDecl e ExplicitSplice = text "$(" <> ppr_splice_decl e <> text ")"
pprSpliceDecl e ImplicitSplice = ppr_splice_decl e
-ppr_splice_decl :: (OutputableBndrId id) => HsSplice id -> SDoc
+ppr_splice_decl :: (SourceTextX p, OutputableBndrId p) => HsSplice p -> SDoc
ppr_splice_decl (HsUntypedSplice _ n e) = ppr_splice empty n e empty
ppr_splice_decl e = pprSplice e
-pprSplice :: (OutputableBndrId id) => HsSplice id -> SDoc
+pprSplice :: (SourceTextX p, OutputableBndrId p) => HsSplice p -> SDoc
pprSplice (HsTypedSplice HasParens n e)
= ppr_splice (text "$$(") n e (text ")")
pprSplice (HsTypedSplice HasDollar n e)
@@ -2238,36 +2258,36 @@ pprSplice (HsUntypedSplice NoParens n e)
pprSplice (HsQuasiQuote n q _ s) = ppr_quasi n q s
pprSplice (HsSpliced _ thing) = ppr thing
-ppr_quasi :: OutputableBndr id => id -> id -> FastString -> SDoc
+ppr_quasi :: OutputableBndr p => p -> p -> FastString -> SDoc
ppr_quasi n quoter quote = ifPprDebug (brackets (ppr n)) <>
char '[' <> ppr quoter <> vbar <>
ppr quote <> text "|]"
-ppr_splice :: (OutputableBndrId id)
- => SDoc -> id -> LHsExpr id -> SDoc -> SDoc
+ppr_splice :: (SourceTextX p, OutputableBndrId p)
+ => SDoc -> (IdP p) -> LHsExpr p -> SDoc -> SDoc
ppr_splice herald n e trail
= herald <> ifPprDebug (brackets (ppr n)) <> ppr e <> trail
-- | Haskell Bracket
-data HsBracket id = ExpBr (LHsExpr id) -- [| expr |]
- | PatBr (LPat id) -- [p| pat |]
- | DecBrL [LHsDecl id] -- [d| decls |]; result of parser
- | DecBrG (HsGroup id) -- [d| decls |]; result of renamer
- | TypBr (LHsType id) -- [t| type |]
- | VarBr Bool id -- True: 'x, False: ''T
- -- (The Bool flag is used only in pprHsBracket)
- | TExpBr (LHsExpr id) -- [|| expr ||]
-deriving instance (DataId id) => Data (HsBracket id)
+data HsBracket p = ExpBr (LHsExpr p) -- [| expr |]
+ | PatBr (LPat p) -- [p| pat |]
+ | DecBrL [LHsDecl p] -- [d| decls |]; result of parser
+ | DecBrG (HsGroup p) -- [d| decls |]; result of renamer
+ | TypBr (LHsType p) -- [t| type |]
+ | VarBr Bool (IdP p) -- True: 'x, False: ''T
+ -- (The Bool flag is used only in pprHsBracket)
+ | TExpBr (LHsExpr p) -- [|| expr ||]
+deriving instance (DataId p) => Data (HsBracket p)
isTypedBracket :: HsBracket id -> Bool
isTypedBracket (TExpBr {}) = True
isTypedBracket _ = False
-instance (OutputableBndrId id) => Outputable (HsBracket id) where
+instance (SourceTextX p, OutputableBndrId p) => Outputable (HsBracket p) where
ppr = pprHsBracket
-pprHsBracket :: (OutputableBndrId id) => HsBracket id -> SDoc
+pprHsBracket :: (SourceTextX p, OutputableBndrId p) => HsBracket p -> SDoc
pprHsBracket (ExpBr e) = thBrackets empty (ppr e)
pprHsBracket (PatBr p) = thBrackets (char 'p') (ppr p)
pprHsBracket (DecBrG gp) = thBrackets (char 'd') (ppr gp)
@@ -2312,8 +2332,8 @@ data ArithSeqInfo id
(LHsExpr id)
deriving instance (DataId id) => Data (ArithSeqInfo id)
-instance (OutputableBndrId id)
- => Outputable (ArithSeqInfo id) where
+instance (SourceTextX p, OutputableBndrId p)
+ => Outputable (ArithSeqInfo p) where
ppr (From e1) = hcat [ppr e1, pp_dotdot]
ppr (FromThen e1 e2) = hcat [ppr e1, comma, space, ppr e2, pp_dotdot]
ppr (FromTo e1 e3) = hcat [ppr e1, pp_dotdot, ppr e3]
@@ -2334,7 +2354,7 @@ pp_dotdot = text " .. "
-- | Haskell Match Context
--
-- Context of a Match
-data HsMatchContext id
+data HsMatchContext id -- Not an extensible tag
= FunRhs (Located id) LexicalFixity -- ^Function binding for f, fixity
| LambdaExpr -- ^Patterns of a lambda
| CaseAlt -- ^Patterns and guards on a case alternative
@@ -2353,7 +2373,7 @@ data HsMatchContext id
| ThPatQuote -- ^A Template Haskell pattern quotation [p| (a,b) |]
| PatSyn -- ^A pattern synonym declaration
deriving Functor
-deriving instance (DataIdPost id) => Data (HsMatchContext id)
+deriving instance (Data id) => Data (HsMatchContext id)
instance OutputableBndr id => Outputable (HsMatchContext id) where
ppr (FunRhs (L _ id) fix) = text "FunRhs" <+> ppr id <+> ppr fix
@@ -2374,7 +2394,8 @@ isPatSynCtxt ctxt =
PatSyn -> True
_ -> False
--- | Haskell Statement Context
+-- | Haskell Statement Context. It expects to be parameterised with one of
+-- 'RdrName', 'Name' or 'Id'
data HsStmtContext id
= ListComp
| MonadComp
@@ -2389,7 +2410,7 @@ data HsStmtContext id
| ParStmtCtxt (HsStmtContext id) -- ^A branch of a parallel stmt
| TransStmtCtxt (HsStmtContext id) -- ^A branch of a transform stmt
deriving Functor
-deriving instance (DataIdPost id) => Data (HsStmtContext id)
+deriving instance (Data id) => Data (HsStmtContext id)
isListCompExpr :: HsStmtContext id -> Bool
-- Uses syntax [ e | quals ]
@@ -2494,8 +2515,8 @@ pprStmtContext (TransStmtCtxt c) =
then sep [text "transformed branch of", pprAStmtContext c]
else pprStmtContext c
-instance (Outputable id, Outputable (NameOrRdrName id))
- => Outputable (HsStmtContext id) where
+instance (Outputable p, Outputable (NameOrRdrName p))
+ => Outputable (HsStmtContext p) where
ppr = pprStmtContext
-- Used to generate the string for a *runtime* error message
@@ -2522,17 +2543,19 @@ matchContextErrString (StmtCtxt ListComp) = text "list comprehension"
matchContextErrString (StmtCtxt MonadComp) = text "monad comprehension"
matchContextErrString (StmtCtxt PArrComp) = text "array comprehension"
-pprMatchInCtxt :: (OutputableBndrId idR,
- Outputable (NameOrRdrName (NameOrRdrName idR)),
+pprMatchInCtxt :: (SourceTextX idR, OutputableBndrId idR,
+ -- TODO:AZ these constraints do not make sense
+ Outputable (NameOrRdrName (NameOrRdrName (IdP idR))),
Outputable body)
=> Match idR body -> SDoc
pprMatchInCtxt match = hang (text "In" <+> pprMatchContext (m_ctxt match)
<> colon)
4 (pprMatch match)
-pprStmtInCtxt :: (OutputableBndrId idL, OutputableBndrId idR,
+pprStmtInCtxt :: (SourceTextX idL, SourceTextX idR,
+ OutputableBndrId idL, OutputableBndrId idR,
Outputable body)
- => HsStmtContext idL -> StmtLR idL idR body -> SDoc
+ => HsStmtContext (IdP idL) -> StmtLR idL idR body -> SDoc
pprStmtInCtxt ctxt (LastStmt e _ _)
| isListCompExpr ctxt -- For [ e | .. ], do not mutter about "stmts"
= hang (text "In the expression:") 2 (ppr e)
diff --git a/compiler/hsSyn/HsExpr.hs-boot b/compiler/hsSyn/HsExpr.hs-boot
index dad2a78185..bac8a5a183 100644
--- a/compiler/hsSyn/HsExpr.hs-boot
+++ b/compiler/hsSyn/HsExpr.hs-boot
@@ -4,6 +4,7 @@
-- in module PlaceHolder
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE RoleAnnotations #-}
+{-# LANGUAGE ExistentialQuantification #-}
module HsExpr where
@@ -11,7 +12,7 @@ import SrcLoc ( Located )
import Outputable ( SDoc, Outputable )
import {-# SOURCE #-} HsPat ( LPat )
import BasicTypes ( SpliceExplicitFlag(..))
-import PlaceHolder ( DataId, OutputableBndrId )
+import HsExtension ( OutputableBndrId, DataId, SourceTextX )
import Data.Data hiding ( Fixity )
type role HsExpr nominal
@@ -27,31 +28,32 @@ data MatchGroup (a :: *) (body :: *)
data GRHSs (a :: *) (body :: *)
data SyntaxExpr (i :: *)
-instance (DataId id) => Data (HsSplice id)
-instance (DataId id) => Data (HsExpr id)
-instance (DataId id) => Data (HsCmd id)
-instance (Data body,DataId id) => Data (MatchGroup id body)
-instance (Data body,DataId id) => Data (GRHSs id body)
-instance (DataId id) => Data (SyntaxExpr id)
+instance (DataId p) => Data (HsSplice p)
+instance (DataId p) => Data (HsExpr p)
+instance (DataId p) => Data (HsCmd p)
+instance (Data body,DataId p) => Data (MatchGroup p body)
+instance (Data body,DataId p) => Data (GRHSs p body)
+instance (DataId p) => Data (SyntaxExpr p)
-instance (OutputableBndrId id) => Outputable (HsExpr id)
-instance (OutputableBndrId id) => Outputable (HsCmd id)
+instance (SourceTextX p, OutputableBndrId p) => Outputable (HsExpr p)
+instance (SourceTextX p, OutputableBndrId p) => Outputable (HsCmd p)
type LHsExpr a = Located (HsExpr a)
-pprLExpr :: (OutputableBndrId id) => LHsExpr id -> SDoc
+pprLExpr :: (SourceTextX p, OutputableBndrId p) => LHsExpr p -> SDoc
-pprExpr :: (OutputableBndrId id) => HsExpr id -> SDoc
+pprExpr :: (SourceTextX p, OutputableBndrId p) => HsExpr p -> SDoc
-pprSplice :: (OutputableBndrId id) => HsSplice id -> SDoc
+pprSplice :: (SourceTextX p, OutputableBndrId p) => HsSplice p -> SDoc
-pprSpliceDecl :: (OutputableBndrId id)
- => HsSplice id -> SpliceExplicitFlag -> SDoc
+pprSpliceDecl :: (SourceTextX p, OutputableBndrId p)
+ => HsSplice p -> SpliceExplicitFlag -> SDoc
-pprPatBind :: (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
-pprFunBind :: (OutputableBndrId idR, Outputable body)
+pprFunBind :: (SourceTextX idR, OutputableBndrId idR, Outputable body)
=> MatchGroup idR body -> SDoc
diff --git a/compiler/hsSyn/HsExtension.hs b/compiler/hsSyn/HsExtension.hs
new file mode 100644
index 0000000000..880f7096c6
--- /dev/null
+++ b/compiler/hsSyn/HsExtension.hs
@@ -0,0 +1,289 @@
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE StandaloneDeriving #-}
+
+module HsExtension where
+
+-- This module captures the type families to precisely identify the extension
+-- points for HsSyn
+
+import GHC.Exts (Constraint)
+import Data.Data hiding ( Fixity )
+import PlaceHolder
+import BasicTypes
+import ConLike
+import NameSet
+import Name
+import RdrName
+import Var
+import Type ( Type )
+import Outputable
+import SrcLoc (Located)
+import Coercion
+import TcEvidence
+
+{-
+Note [Trees that grow]
+~~~~~~~~~~~~~~~~~~~~~~
+
+See https://ghc.haskell.org/trac/ghc/wiki/ImplementingTreesThatGrow
+
+The hsSyn AST is reused across multiple compiler passes. We also have the
+Template Haskell AST, and the haskell-src-exts one (outside of GHC)
+
+Supporting multiple passes means the AST has various warts on it to cope with
+the specifics for the phases, such as the 'ValBindsOut', 'ConPatOut',
+'SigPatOut' etc.
+
+The growable AST will allow each of these variants to be captured explicitly,
+such that they only exist in the given compiler pass AST, as selected by the
+type parameter to the AST.
+
+In addition it will allow tool writers to define their own extensions to capture
+additional information for the tool, in a natural way.
+
+A further goal is to provide a means to harmonise the Template Haskell and
+haskell-src-exts ASTs as well.
+
+-}
+
+-- | Used as a data type index for the hsSyn AST
+data GhcPass (c :: Pass)
+deriving instance Eq (GhcPass c)
+deriving instance Typeable c => Data (GhcPass c)
+
+data Pass = Parsed | Renamed | Typechecked
+ deriving (Data)
+
+-- Type synonyms as a shorthand for tagging
+type GhcPs = GhcPass 'Parsed -- Old 'RdrName' type param
+type GhcRn = GhcPass 'Renamed -- Old 'Name' type param
+type GhcTc = GhcPass 'Typechecked -- Old 'Id' type para,
+type GhcTcId = GhcTc -- Old 'TcId' type param
+
+
+-- | Types that are not defined until after type checking
+type family PostTc x ty -- Note [Pass sensitive types] in PlaceHolder
+type instance PostTc GhcPs ty = PlaceHolder
+type instance PostTc GhcRn ty = PlaceHolder
+type instance PostTc GhcTc ty = ty
+
+-- | Types that are not defined until after renaming
+type family PostRn x ty -- Note [Pass sensitive types] in PlaceHolder
+type instance PostRn GhcPs ty = PlaceHolder
+type instance PostRn GhcRn ty = ty
+type instance PostRn GhcTc ty = ty
+
+-- | Maps the "normal" id type for a given pass
+type family IdP p
+type instance IdP GhcPs = RdrName
+type instance IdP GhcRn = Name
+type instance IdP GhcTc = Id
+
+
+-- We define a type family for each extension point. This is based on prepending
+-- 'X' to the constructor name, for ease of reference.
+type family XHsChar x
+type family XHsCharPrim x
+type family XHsString x
+type family XHsStringPrim x
+type family XHsInt x
+type family XHsIntPrim x
+type family XHsWordPrim x
+type family XHsInt64Prim x
+type family XHsWord64Prim x
+type family XHsInteger x
+type family XHsRat x
+type family XHsFloatPrim x
+type family XHsDoublePrim x
+
+-- | Helper to apply a constraint to all extension points. It has one
+-- entry per extension point type family.
+type ForallX (c :: * -> Constraint) (x :: *) =
+ ( c (XHsChar x)
+ , c (XHsCharPrim x)
+ , c (XHsString x)
+ , c (XHsStringPrim x)
+ , c (XHsInt x)
+ , c (XHsIntPrim x)
+ , c (XHsWordPrim x)
+ , c (XHsInt64Prim x)
+ , c (XHsWord64Prim x)
+ , c (XHsInteger x)
+ , c (XHsRat x)
+ , c (XHsFloatPrim x)
+ , c (XHsDoublePrim x)
+ )
+
+
+-- Provide the specific extension types for the parser phase.
+type instance XHsChar GhcPs = SourceText
+type instance XHsCharPrim GhcPs = SourceText
+type instance XHsString GhcPs = SourceText
+type instance XHsStringPrim GhcPs = SourceText
+type instance XHsInt GhcPs = ()
+type instance XHsIntPrim GhcPs = SourceText
+type instance XHsWordPrim GhcPs = SourceText
+type instance XHsInt64Prim GhcPs = SourceText
+type instance XHsWord64Prim GhcPs = SourceText
+type instance XHsInteger GhcPs = SourceText
+type instance XHsRat GhcPs = ()
+type instance XHsFloatPrim GhcPs = ()
+type instance XHsDoublePrim GhcPs = ()
+
+-- Provide the specific extension types for the renamer phase.
+type instance XHsChar GhcRn = SourceText
+type instance XHsCharPrim GhcRn = SourceText
+type instance XHsString GhcRn = SourceText
+type instance XHsStringPrim GhcRn = SourceText
+type instance XHsInt GhcRn = ()
+type instance XHsIntPrim GhcRn = SourceText
+type instance XHsWordPrim GhcRn = SourceText
+type instance XHsInt64Prim GhcRn = SourceText
+type instance XHsWord64Prim GhcRn = SourceText
+type instance XHsInteger GhcRn = SourceText
+type instance XHsRat GhcRn = ()
+type instance XHsFloatPrim GhcRn = ()
+type instance XHsDoublePrim GhcRn = ()
+
+-- Provide the specific extension types for the typechecker phase.
+type instance XHsChar GhcTc = SourceText
+type instance XHsCharPrim GhcTc = SourceText
+type instance XHsString GhcTc = SourceText
+type instance XHsStringPrim GhcTc = SourceText
+type instance XHsInt GhcTc = ()
+type instance XHsIntPrim GhcTc = SourceText
+type instance XHsWordPrim GhcTc = SourceText
+type instance XHsInt64Prim GhcTc = SourceText
+type instance XHsWord64Prim GhcTc = SourceText
+type instance XHsInteger GhcTc = SourceText
+type instance XHsRat GhcTc = ()
+type instance XHsFloatPrim GhcTc = ()
+type instance XHsDoublePrim GhcTc = ()
+
+
+-- ---------------------------------------------------------------------
+
+-- | The 'SourceText' fields have been moved into the extension fields, thus
+-- placing a requirement in the extension field to contain a 'SourceText' so
+-- that the pretty printing and round tripping of source can continue to
+-- operate.
+--
+-- The 'HasSourceText' class captures this requirement for the relevant fields.
+class HasSourceText a where
+ -- Provide setters to mimic existing constructors
+ noSourceText :: a
+ sourceText :: String -> a
+
+ setSourceText :: SourceText -> a
+ getSourceText :: a -> SourceText
+
+-- | Provide a summary constraint that lists all the extension points requiring
+-- the 'HasSourceText' class, so that it can be changed in one place as the
+-- named extensions change throughout the AST.
+type SourceTextX x =
+ ( HasSourceText (XHsChar x)
+ , HasSourceText (XHsCharPrim x)
+ , HasSourceText (XHsString x)
+ , HasSourceText (XHsStringPrim x)
+ , HasSourceText (XHsIntPrim x)
+ , HasSourceText (XHsWordPrim x)
+ , HasSourceText (XHsInt64Prim x)
+ , HasSourceText (XHsWord64Prim x)
+ , HasSourceText (XHsInteger x)
+ )
+
+
+-- | 'SourceText' trivially implements 'HasSourceText'
+instance HasSourceText SourceText where
+ noSourceText = NoSourceText
+ sourceText s = SourceText s
+
+ setSourceText s = s
+ getSourceText a = a
+
+
+-- ----------------------------------------------------------------------
+-- | Defaults for each annotation, used to simplify creation in arbitrary
+-- contexts
+class HasDefault a where
+ def :: a
+
+instance HasDefault () where
+ def = ()
+
+instance HasDefault SourceText where
+ def = NoSourceText
+
+-- | Provide a single constraint that captures the requirement for a default
+-- across all the extension points.
+type HasDefaultX x = ForallX HasDefault x
+
+-- ----------------------------------------------------------------------
+-- | Conversion of annotations from one type index to another. This is required
+-- where the AST is converted from one pass to another, and the extension values
+-- need to be brought along if possible. So for example a 'SourceText' is
+-- converted via 'id', but needs a type signature to keep the type checker
+-- happy.
+class Convertable a b | a -> b where
+ convert :: a -> b
+
+instance Convertable a a where
+ convert = id
+
+-- | A constraint capturing all the extension points that can be converted via
+-- @instance Convertable a a@
+type ConvertIdX a b =
+ (XHsDoublePrim a ~ XHsDoublePrim b,
+ XHsFloatPrim a ~ XHsFloatPrim b,
+ XHsRat a ~ XHsRat b,
+ XHsInteger a ~ XHsInteger b,
+ XHsWord64Prim a ~ XHsWord64Prim b,
+ XHsInt64Prim a ~ XHsInt64Prim b,
+ XHsWordPrim a ~ XHsWordPrim b,
+ XHsIntPrim a ~ XHsIntPrim b,
+ XHsInt a ~ XHsInt b,
+ XHsStringPrim a ~ XHsStringPrim b,
+ XHsString a ~ XHsString b,
+ XHsCharPrim a ~ XHsCharPrim b,
+ XHsChar a ~ XHsChar b)
+
+
+-- ----------------------------------------------------------------------
+
+--
+type DataId p =
+ ( Data p
+ , ForallX Data p
+ , Data (NameOrRdrName (IdP p))
+
+ , Data (IdP p)
+ , Data (PostRn p (IdP p))
+ , Data (PostRn p (Located Name))
+ , Data (PostRn p Bool)
+ , Data (PostRn p Fixity)
+ , Data (PostRn p NameSet)
+ , Data (PostRn p [Name])
+
+ , Data (PostTc p (IdP p))
+ , Data (PostTc p Coercion)
+ , Data (PostTc p ConLike)
+ , Data (PostTc p HsWrapper)
+ , Data (PostTc p Type)
+ , Data (PostTc p [ConLike])
+ , Data (PostTc p [Type])
+ )
+
+
+-- |Constraint type to bundle up the requirement for 'OutputableBndr' on both
+-- the @id@ and the 'NameOrRdrName' type for it
+type OutputableBndrId id =
+ ( OutputableBndr (NameOrRdrName (IdP id))
+ , OutputableBndr (IdP id)
+ )
diff --git a/compiler/hsSyn/HsImpExp.hs b/compiler/hsSyn/HsImpExp.hs
index 3424a0816c..57f74e3666 100644
--- a/compiler/hsSyn/HsImpExp.hs
+++ b/compiler/hsSyn/HsImpExp.hs
@@ -7,6 +7,10 @@ HsImpExp: Abstract syntax: imports, exports, interfaces
-}
{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
+ -- in module PlaceHolder
module HsImpExp where
@@ -19,6 +23,7 @@ import FieldLabel ( FieldLbl(..) )
import Outputable
import FastString
import SrcLoc
+import HsExtension
import Data.Data
@@ -73,7 +78,7 @@ data ImportDecl name
-- to location in ideclHiding
-- For details on above see note [Api annotations] in ApiAnnotation
- deriving Data
+deriving instance (DataId name) => Data (ImportDecl name)
simpleImportDecl :: ModuleName -> ImportDecl name
simpleImportDecl mn = ImportDecl {
@@ -88,7 +93,7 @@ simpleImportDecl mn = ImportDecl {
ideclHiding = Nothing
}
-instance (OutputableBndr name, HasOccName name) => Outputable (ImportDecl name) where
+instance (OutputableBndrId pass) => Outputable (ImportDecl pass) where
ppr (ImportDecl { ideclSourceSrc = mSrcText, ideclName = mod'
, ideclPkgQual = pkg
, ideclSource = from, ideclSafe = safe
@@ -160,10 +165,10 @@ type LIE name = Located (IE name)
-- | Imported or exported entity.
data IE name
- = IEVar (LIEWrappedName name)
+ = IEVar (LIEWrappedName (IdP name))
-- ^ Imported or Exported Variable
- | IEThingAbs (LIEWrappedName name)
+ | IEThingAbs (LIEWrappedName (IdP name))
-- ^ Imported or exported Thing with Absent list
--
-- The thing is a Class/Type (can't tell)
@@ -172,7 +177,7 @@ data IE name
-- For details on above see note [Api annotations] in ApiAnnotation
-- See Note [Located RdrNames] in HsExpr
- | IEThingAll (LIEWrappedName name)
+ | IEThingAll (LIEWrappedName (IdP name))
-- ^ Imported or exported Thing with All imported or exported
--
-- The thing is a Class/Type and the All refers to methods/constructors
@@ -184,10 +189,10 @@ data IE name
-- For details on above see note [Api annotations] in ApiAnnotation
-- See Note [Located RdrNames] in HsExpr
- | IEThingWith (LIEWrappedName name)
+ | IEThingWith (LIEWrappedName (IdP name))
IEWildcard
- [LIEWrappedName name]
- [Located (FieldLbl name)]
+ [LIEWrappedName (IdP name)]
+ [Located (FieldLbl (IdP name))]
-- ^ Imported or exported Thing With given imported or exported
--
-- The thing is a Class/Type and the imported or exported things are
@@ -209,7 +214,9 @@ data IE name
| IEGroup Int HsDocString -- ^ Doc section heading
| IEDoc HsDocString -- ^ Some documentation
| IEDocNamed String -- ^ Reference to named doc
- deriving (Eq, Data)
+ -- deriving (Eq, Data)
+deriving instance (Eq name, Eq (IdP name)) => Eq (IE name)
+deriving instance (DataId name) => Data (IE name)
-- | Imported or Exported Wildcard
data IEWildcard = NoIEWildcard | IEWildcard Int deriving (Eq, Data)
@@ -231,14 +238,14 @@ gives rise to
See Note [Representing fields in AvailInfo] in Avail for more details.
-}
-ieName :: IE name -> name
+ieName :: IE pass -> IdP pass
ieName (IEVar (L _ n)) = ieWrappedName n
ieName (IEThingAbs (L _ n)) = ieWrappedName n
ieName (IEThingWith (L _ n) _ _ _) = ieWrappedName n
ieName (IEThingAll (L _ n)) = ieWrappedName n
ieName _ = panic "ieName failed pattern match!"
-ieNames :: IE a -> [a]
+ieNames :: IE pass -> [IdP pass]
ieNames (IEVar (L _ n) ) = [ieWrappedName n]
ieNames (IEThingAbs (L _ n) ) = [ieWrappedName n]
ieNames (IEThingAll (L _ n) ) = [ieWrappedName n]
@@ -265,7 +272,7 @@ replaceWrappedName (IEType (L l _)) n = IEType (L l n)
replaceLWrappedName :: LIEWrappedName name1 -> name2 -> LIEWrappedName name2
replaceLWrappedName (L l n) n' = L l (replaceWrappedName n n')
-instance (HasOccName name, OutputableBndr name) => Outputable (IE name) where
+instance (OutputableBndrId pass) => Outputable (IE pass) where
ppr (IEVar var) = ppr (unLoc var)
ppr (IEThingAbs thing) = ppr (unLoc thing)
ppr (IEThingAll thing) = hcat [ppr (unLoc thing), text "(..)"]
@@ -290,14 +297,12 @@ instance (HasOccName name, OutputableBndr name) => Outputable (IE name) where
instance (HasOccName name) => HasOccName (IEWrappedName name) where
occName w = occName (ieWrappedName w)
-instance (OutputableBndr name, HasOccName name)
- => OutputableBndr (IEWrappedName name) where
+instance (OutputableBndr name) => OutputableBndr (IEWrappedName name) where
pprBndr bs w = pprBndr bs (ieWrappedName w)
pprPrefixOcc w = pprPrefixOcc (ieWrappedName w)
pprInfixOcc w = pprInfixOcc (ieWrappedName w)
-instance (HasOccName name, OutputableBndr name)
- => Outputable (IEWrappedName name) where
+instance (OutputableBndr name) => Outputable (IEWrappedName name) where
ppr (IEName n) = pprPrefixOcc (unLoc n)
ppr (IEPattern n) = text "pattern" <+> pprPrefixOcc (unLoc n)
ppr (IEType n) = text "type" <+> pprPrefixOcc (unLoc n)
diff --git a/compiler/hsSyn/HsLit.hs b/compiler/hsSyn/HsLit.hs
index 0226591729..46e5dd5aa3 100644
--- a/compiler/hsSyn/HsLit.hs
+++ b/compiler/hsSyn/HsLit.hs
@@ -13,6 +13,7 @@
{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
-- in module PlaceHolder
{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE TypeFamilies #-}
module HsLit where
@@ -24,7 +25,7 @@ import BasicTypes ( IntegralLit(..),FractionalLit(..),negateIntegralLit,
import Type ( Type )
import Outputable
import FastString
-import PlaceHolder ( PostTc,PostRn,DataId,OutputableBndrId )
+import HsExtension
import Data.ByteString (ByteString)
import Data.Data hiding ( Fixity )
@@ -39,65 +40,68 @@ import Data.Data hiding ( Fixity )
-- Note [Literal source text] in BasicTypes for SourceText fields in
-- the following
+-- Note [Trees that grow] in HsExtension for the Xxxxx fields in the following
-- | Haskell Literal
-data HsLit
- = HsChar SourceText Char
+data HsLit x
+ = HsChar (XHsChar x) {- SourceText -} Char
-- ^ Character
- | HsCharPrim SourceText Char
+ | HsCharPrim (XHsCharPrim x) {- SourceText -} Char
-- ^ Unboxed character
- | HsString SourceText FastString
+ | HsString (XHsString x) {- SourceText -} FastString
-- ^ String
- | HsStringPrim SourceText ByteString
+ | HsStringPrim (XHsStringPrim x) {- SourceText -} ByteString
-- ^ Packed bytes
- | HsInt IntegralLit
+ | HsInt (XHsInt x) IntegralLit
-- ^ Genuinely an Int; arises from
-- @TcGenDeriv@, and from TRANSLATION
- | HsIntPrim SourceText Integer
+ | HsIntPrim (XHsIntPrim x) {- SourceText -} Integer
-- ^ literal @Int#@
- | HsWordPrim SourceText Integer
+ | HsWordPrim (XHsWordPrim x) {- SourceText -} Integer
-- ^ literal @Word#@
- | HsInt64Prim SourceText Integer
+ | HsInt64Prim (XHsInt64Prim x) {- SourceText -} Integer
-- ^ literal @Int64#@
- | HsWord64Prim SourceText Integer
+ | HsWord64Prim (XHsWord64Prim x) {- SourceText -} Integer
-- ^ literal @Word64#@
- | HsInteger SourceText Integer Type
+ | HsInteger (XHsInteger x) {- SourceText -} Integer Type
-- ^ Genuinely an integer; arises only
-- from TRANSLATION (overloaded
-- literals are done with HsOverLit)
- | HsRat FractionalLit Type
+ | HsRat (XHsRat x) FractionalLit Type
-- ^ Genuinely a rational; arises only from
-- TRANSLATION (overloaded literals are
-- done with HsOverLit)
- | HsFloatPrim FractionalLit
+ | HsFloatPrim (XHsFloatPrim x) FractionalLit
-- ^ Unboxed Float
- | HsDoublePrim FractionalLit
+ | HsDoublePrim (XHsDoublePrim x) FractionalLit
-- ^ Unboxed Double
- deriving Data
-instance Eq HsLit where
+deriving instance (DataId x) => Data (HsLit x)
+
+
+instance Eq (HsLit x) where
(HsChar _ x1) == (HsChar _ x2) = x1==x2
(HsCharPrim _ x1) == (HsCharPrim _ x2) = x1==x2
(HsString _ x1) == (HsString _ x2) = x1==x2
(HsStringPrim _ x1) == (HsStringPrim _ x2) = x1==x2
- (HsInt x1) == (HsInt x2) = x1==x2
+ (HsInt _ x1) == (HsInt _ x2) = x1==x2
(HsIntPrim _ x1) == (HsIntPrim _ x2) = x1==x2
(HsWordPrim _ x1) == (HsWordPrim _ x2) = x1==x2
(HsInt64Prim _ x1) == (HsInt64Prim _ x2) = x1==x2
(HsWord64Prim _ x1) == (HsWord64Prim _ x2) = x1==x2
(HsInteger _ x1 _) == (HsInteger _ x2 _) = x1==x2
- (HsRat x1 _) == (HsRat x2 _) = x1==x2
- (HsFloatPrim x1) == (HsFloatPrim x2) = x1==x2
- (HsDoublePrim x1) == (HsDoublePrim x2) = x1==x2
+ (HsRat _ x1 _) == (HsRat _ x2 _) = x1==x2
+ (HsFloatPrim _ x1) == (HsFloatPrim _ x2) = x1==x2
+ (HsDoublePrim _ x1) == (HsDoublePrim _ x2) = x1==x2
_ == _ = False
-- | Haskell Overloaded Literal
-data HsOverLit id
+data HsOverLit p
= OverLit {
ol_val :: OverLitVal,
- ol_rebindable :: PostRn id Bool, -- Note [ol_rebindable]
- ol_witness :: HsExpr id, -- Note [Overloaded literal witnesses]
- ol_type :: PostTc id Type }
-deriving instance (DataId id) => Data (HsOverLit id)
+ ol_rebindable :: PostRn p Bool, -- Note [ol_rebindable]
+ ol_witness :: HsExpr p, -- Note [Overloaded literal witnesses]
+ ol_type :: PostTc p Type }
+deriving instance (DataId p, DataId p) => Data (HsOverLit p)
-- Note [Literal source text] in BasicTypes for SourceText fields in
-- the following
@@ -113,9 +117,26 @@ negateOverLitVal (HsIntegral i) = HsIntegral (negateIntegralLit i)
negateOverLitVal (HsFractional f) = HsFractional (negateFractionalLit f)
negateOverLitVal _ = panic "negateOverLitVal: argument is not a number"
-overLitType :: HsOverLit a -> PostTc a Type
+overLitType :: HsOverLit p -> PostTc p Type
overLitType = ol_type
+-- | Convert a literal from one index type to another, updating the annotations
+-- according to the relevant 'Convertable' instance
+convertLit :: (ConvertIdX a b) => HsLit a -> HsLit b
+convertLit (HsChar a x) = (HsChar (convert a) x)
+convertLit (HsCharPrim a x) = (HsCharPrim (convert a) x)
+convertLit (HsString a x) = (HsString (convert a) x)
+convertLit (HsStringPrim a x) = (HsStringPrim (convert a) x)
+convertLit (HsInt a x) = (HsInt (convert a) x)
+convertLit (HsIntPrim a x) = (HsIntPrim (convert a) x)
+convertLit (HsWordPrim a x) = (HsWordPrim (convert a) x)
+convertLit (HsInt64Prim a x) = (HsInt64Prim (convert a) x)
+convertLit (HsWord64Prim a x) = (HsWord64Prim (convert a) x)
+convertLit (HsInteger a x b) = (HsInteger (convert a) x b)
+convertLit (HsRat a x b) = (HsRat (convert a) x b)
+convertLit (HsFloatPrim a x) = (HsFloatPrim (convert a) x)
+convertLit (HsDoublePrim a x) = (HsDoublePrim (convert a) x)
+
{-
Note [ol_rebindable]
~~~~~~~~~~~~~~~~~~~~
@@ -148,7 +169,7 @@ found to have.
-- Comparison operations are needed when grouping literals
-- for compiling pattern-matching (module MatchLit)
-instance Eq (HsOverLit id) where
+instance Eq (HsOverLit p) where
(OverLit {ol_val = val1}) == (OverLit {ol_val=val2}) = val1 == val2
instance Eq OverLitVal where
@@ -157,7 +178,7 @@ instance Eq OverLitVal where
(HsIsString _ s1) == (HsIsString _ s2) = s1 == s2
_ == _ = False
-instance Ord (HsOverLit id) where
+instance Ord (HsOverLit p) where
compare (OverLit {ol_val=val1}) (OverLit {ol_val=val2}) = val1 `compare` val2
instance Ord OverLitVal where
@@ -171,27 +192,37 @@ instance Ord OverLitVal where
compare (HsIsString _ _) (HsIntegral _) = GT
compare (HsIsString _ _) (HsFractional _) = GT
-instance Outputable HsLit where
- ppr (HsChar st c) = pprWithSourceText st (pprHsChar c)
- ppr (HsCharPrim st c) = pp_st_suffix st primCharSuffix (pprPrimChar c)
- ppr (HsString st s) = pprWithSourceText st (pprHsString s)
- ppr (HsStringPrim st s) = pprWithSourceText st (pprHsBytes s)
- ppr (HsInt i) = pprWithSourceText (il_text i) (integer (il_value i))
- ppr (HsInteger st i _) = pprWithSourceText st (integer i)
- ppr (HsRat f _) = ppr f
- ppr (HsFloatPrim f) = ppr f <> primFloatSuffix
- ppr (HsDoublePrim d) = ppr d <> primDoubleSuffix
- ppr (HsIntPrim st i) = pprWithSourceText st (pprPrimInt i)
- ppr (HsWordPrim st w) = pprWithSourceText st (pprPrimWord w)
- ppr (HsInt64Prim st i) = pp_st_suffix st primInt64Suffix (pprPrimInt64 i)
- ppr (HsWord64Prim st w) = pp_st_suffix st primWord64Suffix (pprPrimWord64 w)
+-- Instance specific to GhcPs, need the SourceText
+instance (SourceTextX x) => Outputable (HsLit x) where
+ ppr (HsChar st c) = pprWithSourceText (getSourceText st) (pprHsChar c)
+ ppr (HsCharPrim st c)
+ = pp_st_suffix (getSourceText st) primCharSuffix (pprPrimChar c)
+ ppr (HsString st s)
+ = pprWithSourceText (getSourceText st) (pprHsString s)
+ ppr (HsStringPrim st s)
+ = pprWithSourceText (getSourceText st) (pprHsBytes s)
+ ppr (HsInt _ i)
+ = pprWithSourceText (il_text i) (integer (il_value i))
+ ppr (HsInteger st i _) = pprWithSourceText (getSourceText st) (integer i)
+ ppr (HsRat _ f _) = ppr f
+ ppr (HsFloatPrim _ f) = ppr f <> primFloatSuffix
+ ppr (HsDoublePrim _ d) = ppr d <> primDoubleSuffix
+ ppr (HsIntPrim st i)
+ = pprWithSourceText (getSourceText st) (pprPrimInt i)
+ ppr (HsWordPrim st w)
+ = pprWithSourceText (getSourceText st) (pprPrimWord w)
+ ppr (HsInt64Prim st i)
+ = pp_st_suffix (getSourceText st) primInt64Suffix (pprPrimInt64 i)
+ ppr (HsWord64Prim st w)
+ = pp_st_suffix (getSourceText st) primWord64Suffix (pprPrimWord64 w)
pp_st_suffix :: SourceText -> SDoc -> SDoc -> SDoc
pp_st_suffix NoSourceText _ doc = doc
pp_st_suffix (SourceText st) suffix _ = text st <> suffix
-- in debug mode, print the expression that it's resolved to, too
-instance (OutputableBndrId id) => Outputable (HsOverLit id) where
+instance (SourceTextX p, OutputableBndrId p)
+ => Outputable (HsOverLit p) where
ppr (OverLit {ol_val=val, ol_witness=witness})
= ppr val <+> (ifPprDebug (parens (pprExpr witness)))
@@ -206,17 +237,18 @@ instance Outputable OverLitVal where
-- mainly for too reasons:
-- * We do not want to expose their internal representation
-- * The warnings become too messy
-pmPprHsLit :: HsLit -> SDoc
+pmPprHsLit :: (SourceTextX x) => HsLit x -> SDoc
pmPprHsLit (HsChar _ c) = pprHsChar c
pmPprHsLit (HsCharPrim _ c) = pprHsChar c
-pmPprHsLit (HsString st s) = pprWithSourceText st (pprHsString s)
+pmPprHsLit (HsString st s) = pprWithSourceText (getSourceText st)
+ (pprHsString s)
pmPprHsLit (HsStringPrim _ s) = pprHsBytes s
-pmPprHsLit (HsInt i) = integer (il_value i)
+pmPprHsLit (HsInt _ i) = integer (il_value i)
pmPprHsLit (HsIntPrim _ i) = integer i
pmPprHsLit (HsWordPrim _ w) = integer w
pmPprHsLit (HsInt64Prim _ i) = integer i
pmPprHsLit (HsWord64Prim _ w) = integer w
pmPprHsLit (HsInteger _ i _) = integer i
-pmPprHsLit (HsRat f _) = ppr f
-pmPprHsLit (HsFloatPrim f) = ppr f
-pmPprHsLit (HsDoublePrim d) = ppr d
+pmPprHsLit (HsRat _ f _) = ppr f
+pmPprHsLit (HsFloatPrim _ f) = ppr f
+pmPprHsLit (HsDoublePrim _ d) = ppr d
diff --git a/compiler/hsSyn/HsPat.hs b/compiler/hsSyn/HsPat.hs
index 174e83702e..93ad9ec383 100644
--- a/compiler/hsSyn/HsPat.hs
+++ b/compiler/hsSyn/HsPat.hs
@@ -43,7 +43,7 @@ import {-# SOURCE #-} HsExpr (SyntaxExpr, LHsExpr, HsSplice, pprLExpr
-- friends:
import HsBinds
import HsLit
-import PlaceHolder
+import HsExtension
import HsTypes
import TcEvidence
import BasicTypes
@@ -64,50 +64,51 @@ import Maybes
-- libraries:
import Data.Data hiding (TyCon,Fixity)
-type InPat id = LPat id -- No 'Out' constructors
-type OutPat id = LPat id -- No 'In' constructors
+type InPat p = LPat p -- No 'Out' constructors
+type OutPat p = LPat p -- No 'In' constructors
-type LPat id = Located (Pat id)
+type LPat p = Located (Pat p)
-- | Pattern
--
-- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnBang'
-- For details on above see note [Api annotations] in ApiAnnotation
-data Pat id
+data Pat p
= ------------ Simple patterns ---------------
- WildPat (PostTc id Type) -- ^ Wildcard Pattern
+ WildPat (PostTc p Type) -- ^ Wildcard Pattern
-- The sole reason for a type on a WildPat is to
-- support hsPatType :: Pat Id -> Type
- | VarPat (Located id) -- ^ Variable Pattern
+ -- AZ:TODO above comment needs to be updated
+ | VarPat (Located (IdP p)) -- ^ Variable Pattern
-- See Note [Located RdrNames] in HsExpr
- | LazyPat (LPat id) -- ^ Lazy Pattern
+ | LazyPat (LPat p) -- ^ Lazy Pattern
-- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnTilde'
-- For details on above see note [Api annotations] in ApiAnnotation
- | AsPat (Located id) (LPat id) -- ^ As pattern
+ | AsPat (Located (IdP p)) (LPat p) -- ^ As pattern
-- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnAt'
-- For details on above see note [Api annotations] in ApiAnnotation
- | ParPat (LPat id) -- ^ Parenthesised pattern
+ | ParPat (LPat p) -- ^ Parenthesised pattern
-- See Note [Parens in HsSyn] in HsExpr
-- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'('@,
-- 'ApiAnnotation.AnnClose' @')'@
-- For details on above see note [Api annotations] in ApiAnnotation
- | BangPat (LPat id) -- ^ Bang pattern
+ | BangPat (LPat p) -- ^ Bang pattern
-- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnBang'
-- For details on above see note [Api annotations] in ApiAnnotation
------------ Lists, tuples, arrays ---------------
- | ListPat [LPat id]
- (PostTc id Type) -- The type of the elements
- (Maybe (PostTc id Type, SyntaxExpr id)) -- For rebindable syntax
+ | ListPat [LPat p]
+ (PostTc p Type) -- The type of the elements
+ (Maybe (PostTc p Type, SyntaxExpr p)) -- For rebindable syntax
-- For OverloadedLists a Just (ty,fn) gives
-- overall type of the pattern, and the toList
-- function to convert the scrutinee to a list value
@@ -118,11 +119,11 @@ data Pat id
-- For details on above see note [Api annotations] in ApiAnnotation
- | TuplePat [LPat id] -- Tuple sub-patterns
+ | TuplePat [LPat p] -- Tuple sub-patterns
Boxity -- UnitPat is TuplePat []
- [PostTc id Type] -- [] before typechecker, filled in afterwards
+ [PostTc p Type] -- [] before typechecker, filled in afterwards
-- with the types of the tuple components
- -- You might think that the PostTc id Type was redundant, because we can
+ -- You might think that the PostTc p Type was redundant, because we can
-- get the pattern type by getting the types of the sub-patterns.
-- But it's essential
-- data T a where
@@ -143,10 +144,10 @@ data Pat id
-- 'ApiAnnotation.AnnOpen' @'('@ or @'(#'@,
-- 'ApiAnnotation.AnnClose' @')'@ or @'#)'@
- | SumPat (LPat id) -- Sum sub-pattern
+ | SumPat (LPat p) -- Sum sub-pattern
ConTag -- Alternative (one-based)
Arity -- Arity
- (PostTc id [Type]) -- PlaceHolder before typechecker, filled in
+ (PostTc p [Type]) -- PlaceHolder before typechecker, filled in
-- afterwards with the types of the
-- alternative
-- ^ Anonymous sum pattern
@@ -156,15 +157,15 @@ data Pat id
-- 'ApiAnnotation.AnnClose' @'#)'@
-- For details on above see note [Api annotations] in ApiAnnotation
- | PArrPat [LPat id] -- Syntactic parallel array
- (PostTc id Type) -- The type of the elements
+ | PArrPat [LPat p] -- Syntactic parallel array
+ (PostTc p Type) -- The type of the elements
-- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'[:'@,
-- 'ApiAnnotation.AnnClose' @':]'@
-- For details on above see note [Api annotations] in ApiAnnotation
------------ Constructor patterns ---------------
- | ConPatIn (Located id)
- (HsConPatDetails id)
+ | ConPatIn (Located (IdP p))
+ (HsConPatDetails p)
-- ^ Constructor Pattern In
| ConPatOut {
@@ -181,7 +182,7 @@ data Pat id
-- is to ensure their kinds are zonked
pat_binds :: TcEvBinds, -- Bindings involving those dictionaries
- pat_args :: HsConPatDetails id,
+ pat_args :: HsConPatDetails p,
pat_wrap :: HsWrapper -- Extra wrapper to pass to the matcher
-- Only relevant for pattern-synonyms;
-- ignored for data cons
@@ -192,9 +193,9 @@ data Pat id
-- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnRarrow'
-- For details on above see note [Api annotations] in ApiAnnotation
- | ViewPat (LHsExpr id)
- (LPat id)
- (PostTc id Type) -- The overall type of the pattern
+ | ViewPat (LHsExpr p)
+ (LPat p)
+ (PostTc p Type) -- The overall type of the pattern
-- (= the argument type of the view function)
-- for hsPatType.
-- ^ View Pattern
@@ -204,68 +205,69 @@ data Pat id
-- 'ApiAnnotation.AnnClose' @')'@
-- For details on above see note [Api annotations] in ApiAnnotation
- | SplicePat (HsSplice id) -- ^ Splice Pattern (Includes quasi-quotes)
+ | SplicePat (HsSplice p) -- ^ Splice Pattern (Includes quasi-quotes)
------------ Literal and n+k patterns ---------------
- | LitPat HsLit -- ^ Literal Pattern
+ | LitPat (HsLit p) -- ^ Literal Pattern
-- Used for *non-overloaded* literal patterns:
-- Int#, Char#, Int, Char, String, etc.
| NPat -- Natural Pattern
-- Used for all overloaded literals,
-- including overloaded strings with -XOverloadedStrings
- (Located (HsOverLit id)) -- ALWAYS positive
- (Maybe (SyntaxExpr id)) -- Just (Name of 'negate') for negative
- -- patterns, Nothing otherwise
- (SyntaxExpr id) -- Equality checker, of type t->t->Bool
- (PostTc id Type) -- Overall type of pattern. Might be
- -- different than the literal's type
- -- if (==) or negate changes the type
+ (Located (HsOverLit p)) -- ALWAYS positive
+ (Maybe (SyntaxExpr p)) -- Just (Name of 'negate') for
+ -- negative patterns, Nothing
+ -- otherwise
+ (SyntaxExpr p) -- Equality checker, of type t->t->Bool
+ (PostTc p Type) -- Overall type of pattern. Might be
+ -- different than the literal's type
+ -- if (==) or negate changes the type
-- ^ Natural Pattern
--
-- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnVal' @'+'@
-- For details on above see note [Api annotations] in ApiAnnotation
- | NPlusKPat (Located id) -- n+k pattern
- (Located (HsOverLit id)) -- It'll always be an HsIntegral
- (HsOverLit id) -- See Note [NPlusK patterns] in TcPat
+ | NPlusKPat (Located (IdP p)) -- n+k pattern
+ (Located (HsOverLit p)) -- It'll always be an HsIntegral
+ (HsOverLit p) -- See Note [NPlusK patterns] in TcPat
-- NB: This could be (PostTc ...), but that induced a
-- a new hs-boot file. Not worth it.
- (SyntaxExpr id) -- (>=) function, of type t1->t2->Bool
- (SyntaxExpr id) -- Name of '-' (see RnEnv.lookupSyntaxName)
- (PostTc id Type) -- Type of overall pattern
+ (SyntaxExpr p) -- (>=) function, of type t1->t2->Bool
+ (SyntaxExpr p) -- Name of '-' (see RnEnv.lookupSyntaxName)
+ (PostTc p Type) -- Type of overall pattern
-- ^ n+k pattern
------------ Pattern type signatures ---------------
-- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDcolon'
-- For details on above see note [Api annotations] in ApiAnnotation
- | SigPatIn (LPat id) -- Pattern with a type signature
- (LHsSigWcType id) -- Signature can bind both
+ | SigPatIn (LPat p) -- Pattern with a type signature
+ (LHsSigWcType p) -- Signature can bind both
-- kind and type vars
-- ^ Pattern with a type signature
- | SigPatOut (LPat id)
+ | SigPatOut (LPat p)
Type
-- ^ Pattern with a type signature
------------ Pattern coercions (translation only) ---------------
- | CoPat HsWrapper -- Coercion Pattern
- -- If co :: t1 ~ t2, p :: t2,
- -- then (CoPat co p) :: t1
- (Pat id) -- Why not LPat? Ans: existing locn will do
- Type -- Type of whole pattern, t1
+ | CoPat HsWrapper -- Coercion Pattern
+ -- If co :: t1 ~ t2, p :: t2,
+ -- then (CoPat co p) :: t1
+ (Pat p) -- Why not LPat? Ans: existing locn will do
+ Type -- Type of whole pattern, t1
-- During desugaring a (CoPat co pat) turns into a cast with 'co' on
-- the scrutinee, followed by a match on 'pat'
-- ^ Coercion Pattern
-deriving instance (DataId id) => Data (Pat id)
+deriving instance (DataId p) => Data (Pat p)
-- | Haskell Constructor Pattern Details
-type HsConPatDetails id = HsConDetails (LPat id) (HsRecFields id (LPat id))
+type HsConPatDetails p = HsConDetails (LPat p) (HsRecFields p (LPat p))
-hsConPatArgs :: HsConPatDetails id -> [LPat id]
+hsConPatArgs :: HsConPatDetails p -> [LPat p]
hsConPatArgs (PrefixCon ps) = ps
hsConPatArgs (RecCon fs) = map (hsRecFieldArg . unLoc) (rec_flds fs)
hsConPatArgs (InfixCon p1 p2) = [p1,p2]
@@ -274,13 +276,13 @@ hsConPatArgs (InfixCon p1 p2) = [p1,p2]
--
-- HsRecFields is used only for patterns and expressions (not data type
-- declarations)
-data HsRecFields id arg -- A bunch of record fields
+data HsRecFields p arg -- A bunch of record fields
-- { x = 3, y = True }
-- Used for both expressions and patterns
- = HsRecFields { rec_flds :: [LHsRecField id arg],
+ = HsRecFields { rec_flds :: [LHsRecField p arg],
rec_dotdot :: Maybe Int } -- Note [DotDot fields]
deriving (Functor, Foldable, Traversable)
-deriving instance (DataId id, Data arg) => Data (HsRecFields id arg)
+deriving instance (DataId p, Data arg) => Data (HsRecFields p arg)
-- Note [DotDot fields]
@@ -298,19 +300,19 @@ deriving instance (DataId id, Data arg) => Data (HsRecFields id arg)
-- and the remainder being 'filled in' implicitly
-- | Located Haskell Record Field
-type LHsRecField' id arg = Located (HsRecField' id arg)
+type LHsRecField' p arg = Located (HsRecField' p arg)
-- | Located Haskell Record Field
-type LHsRecField id arg = Located (HsRecField id arg)
+type LHsRecField p arg = Located (HsRecField p arg)
-- | Located Haskell Record Update Field
-type LHsRecUpdField id = Located (HsRecUpdField id)
+type LHsRecUpdField p = Located (HsRecUpdField p)
-- | Haskell Record Field
-type HsRecField id arg = HsRecField' (FieldOcc id) arg
+type HsRecField p arg = HsRecField' (FieldOcc p) arg
-- | Haskell Record Update Field
-type HsRecUpdField id = HsRecField' (AmbiguousFieldOcc id) (LHsExpr id)
+type HsRecUpdField p = HsRecField' (AmbiguousFieldOcc p) (LHsExpr p)
-- | Haskell Record Field
--
@@ -378,26 +380,26 @@ data HsRecField' id arg = HsRecField {
--
-- See also Note [Disambiguating record fields] in TcExpr.
-hsRecFields :: HsRecFields id arg -> [PostRn id id]
+hsRecFields :: HsRecFields p arg -> [PostRn p (IdP p)]
hsRecFields rbinds = map (unLoc . hsRecFieldSel . unLoc) (rec_flds rbinds)
-- Probably won't typecheck at once, things have changed :/
-hsRecFieldsArgs :: HsRecFields id arg -> [arg]
+hsRecFieldsArgs :: HsRecFields p arg -> [arg]
hsRecFieldsArgs rbinds = map (hsRecFieldArg . unLoc) (rec_flds rbinds)
-hsRecFieldSel :: HsRecField name arg -> Located (PostRn name name)
+hsRecFieldSel :: HsRecField pass arg -> Located (PostRn pass (IdP pass))
hsRecFieldSel = fmap selectorFieldOcc . hsRecFieldLbl
-hsRecFieldId :: HsRecField Id arg -> Located Id
+hsRecFieldId :: HsRecField GhcTc arg -> Located Id
hsRecFieldId = hsRecFieldSel
-hsRecUpdFieldRdr :: HsRecUpdField id -> Located RdrName
+hsRecUpdFieldRdr :: HsRecUpdField p -> Located RdrName
hsRecUpdFieldRdr = fmap rdrNameAmbiguousFieldOcc . hsRecFieldLbl
-hsRecUpdFieldId :: HsRecField' (AmbiguousFieldOcc Id) arg -> Located Id
+hsRecUpdFieldId :: HsRecField' (AmbiguousFieldOcc GhcTc) arg -> Located Id
hsRecUpdFieldId = fmap selectorFieldOcc . hsRecUpdFieldOcc
-hsRecUpdFieldOcc :: HsRecField' (AmbiguousFieldOcc Id) arg -> LFieldOcc Id
+hsRecUpdFieldOcc :: HsRecField' (AmbiguousFieldOcc GhcTc) arg -> LFieldOcc GhcTc
hsRecUpdFieldOcc = fmap unambiguousFieldOcc . hsRecFieldLbl
@@ -409,7 +411,8 @@ hsRecUpdFieldOcc = fmap unambiguousFieldOcc . hsRecFieldLbl
************************************************************************
-}
-instance (OutputableBndrId name) => Outputable (Pat name) where
+instance (SourceTextX pass, OutputableBndrId pass)
+ => Outputable (Pat pass) where
ppr = pprPat
pprPatBndr :: OutputableBndr name => name -> SDoc
@@ -421,10 +424,10 @@ pprPatBndr var -- Print with type info if -dppr-debug is on
else
pprPrefixOcc var
-pprParendLPat :: (OutputableBndrId name) => LPat name -> SDoc
+pprParendLPat :: (SourceTextX pass, OutputableBndrId pass) => LPat pass -> SDoc
pprParendLPat (L _ p) = pprParendPat p
-pprParendPat :: (OutputableBndrId name) => Pat name -> SDoc
+pprParendPat :: (SourceTextX pass, OutputableBndrId pass) => Pat pass -> SDoc
pprParendPat p = sdocWithDynFlags $ \ dflags ->
if need_parens dflags p
then parens (pprPat p)
@@ -438,7 +441,7 @@ pprParendPat p = sdocWithDynFlags $ \ dflags ->
-- But otherwise the CoPat is discarded, so it
-- is the pattern inside that matters. Sigh.
-pprPat :: (OutputableBndrId name) => Pat name -> SDoc
+pprPat :: (SourceTextX pass, OutputableBndrId pass) => Pat pass -> SDoc
pprPat (VarPat (L _ var)) = pprPatBndr var
pprPat (WildPat _) = char '_'
pprPat (LazyPat pat) = char '~' <> pprParendLPat pat
@@ -475,18 +478,18 @@ pprPat (ConPatOut { pat_con = con, pat_tvs = tvs, pat_dicts = dicts,
else pprUserCon (unLoc con) details
-pprUserCon :: (OutputableBndr con, OutputableBndrId id)
- => con -> HsConPatDetails id -> SDoc
+pprUserCon :: (SourceTextX p, OutputableBndr con, OutputableBndrId p)
+ => con -> HsConPatDetails p -> SDoc
pprUserCon c (InfixCon p1 p2) = ppr p1 <+> pprInfixOcc c <+> ppr p2
pprUserCon c details = pprPrefixOcc c <+> pprConArgs details
-pprConArgs :: (OutputableBndrId id) => HsConPatDetails id -> SDoc
+pprConArgs :: (SourceTextX p, OutputableBndrId p) => HsConPatDetails p -> SDoc
pprConArgs (PrefixCon pats) = sep (map pprParendLPat pats)
pprConArgs (InfixCon p1 p2) = sep [pprParendLPat p1, pprParendLPat p2]
pprConArgs (RecCon rpats) = ppr rpats
instance (Outputable arg)
- => Outputable (HsRecFields id arg) where
+ => Outputable (HsRecFields p arg) where
ppr (HsRecFields { rec_flds = flds, rec_dotdot = Nothing })
= braces (fsep (punctuate comma (map ppr flds)))
ppr (HsRecFields { rec_flds = flds, rec_dotdot = Just n })
@@ -494,8 +497,8 @@ instance (Outputable arg)
where
dotdot = text ".." <+> ifPprDebug (ppr (drop n flds))
-instance (Outputable id, Outputable arg)
- => Outputable (HsRecField' id arg) where
+instance (Outputable p, Outputable arg)
+ => Outputable (HsRecField' p arg) where
ppr (HsRecField { hsRecFieldLbl = f, hsRecFieldArg = arg,
hsRecPun = pun })
= ppr f <+> (ppUnless pun $ equals <+> ppr arg)
@@ -509,19 +512,19 @@ instance (Outputable id, Outputable arg)
************************************************************************
-}
-mkPrefixConPat :: DataCon -> [OutPat id] -> [Type] -> OutPat id
+mkPrefixConPat :: DataCon -> [OutPat p] -> [Type] -> OutPat p
-- Make a vanilla Prefix constructor pattern
mkPrefixConPat dc pats tys
= noLoc $ ConPatOut { pat_con = noLoc (RealDataCon dc), pat_tvs = [], pat_dicts = [],
pat_binds = emptyTcEvBinds, pat_args = PrefixCon pats,
pat_arg_tys = tys, pat_wrap = idHsWrapper }
-mkNilPat :: Type -> OutPat id
+mkNilPat :: Type -> OutPat p
mkNilPat ty = mkPrefixConPat nilDataCon [] [ty]
-mkCharLitPat :: SourceText -> Char -> OutPat id
+mkCharLitPat :: (SourceTextX p) => SourceText -> Char -> OutPat p
mkCharLitPat src c = mkPrefixConPat charDataCon
- [noLoc $ LitPat (HsCharPrim src c)] []
+ [noLoc $ LitPat (HsCharPrim (setSourceText src) c)] []
{-
************************************************************************
@@ -555,16 +558,16 @@ patterns are treated specially, of course.
The 1.3 report defines what ``irrefutable'' and ``failure-free'' patterns are.
-}
-isBangedPatBind :: HsBind id -> Bool
+isBangedPatBind :: HsBind p -> Bool
isBangedPatBind (PatBind {pat_lhs = pat}) = isBangedLPat pat
isBangedPatBind _ = False
-isBangedLPat :: LPat id -> Bool
+isBangedLPat :: LPat p -> Bool
isBangedLPat (L _ (ParPat p)) = isBangedLPat p
isBangedLPat (L _ (BangPat {})) = True
isBangedLPat _ = False
-looksLazyPatBind :: HsBind id -> Bool
+looksLazyPatBind :: HsBind p -> Bool
-- Returns True of anything *except*
-- a StrictHsBind (as above) or
-- a VarPat
@@ -579,7 +582,7 @@ looksLazyPatBind (AbsBindsSig { abs_sig_bind = L _ bind })
looksLazyPatBind _
= False
-looksLazyLPat :: LPat id -> Bool
+looksLazyLPat :: LPat p -> Bool
looksLazyLPat (L _ (ParPat p)) = looksLazyLPat p
looksLazyLPat (L _ (AsPat _ p)) = looksLazyLPat p
looksLazyLPat (L _ (BangPat {})) = False
@@ -587,7 +590,7 @@ looksLazyLPat (L _ (VarPat {})) = False
looksLazyLPat (L _ (WildPat {})) = False
looksLazyLPat _ = True
-isIrrefutableHsPat :: (OutputableBndrId id) => LPat id -> Bool
+isIrrefutableHsPat :: (SourceTextX p, OutputableBndrId p) => LPat p -> Bool
-- (isIrrefutableHsPat p) is true if matching against p cannot fail,
-- in the sense of falling through to the next pattern.
-- (NB: this is not quite the same as the (silly) defn
@@ -671,13 +674,13 @@ conPatNeedsParens (RecCon {}) = False
-}
-- May need to add more cases
-collectEvVarsPats :: [Pat id] -> Bag EvVar
+collectEvVarsPats :: [Pat p] -> Bag EvVar
collectEvVarsPats = unionManyBags . map collectEvVarsPat
-collectEvVarsLPat :: LPat id -> Bag EvVar
+collectEvVarsLPat :: LPat p -> Bag EvVar
collectEvVarsLPat (L _ pat) = collectEvVarsPat pat
-collectEvVarsPat :: Pat id -> Bag EvVar
+collectEvVarsPat :: Pat p -> Bag EvVar
collectEvVarsPat pat =
case pat of
LazyPat p -> collectEvVarsLPat p
diff --git a/compiler/hsSyn/HsPat.hs-boot b/compiler/hsSyn/HsPat.hs-boot
index aba5686085..8cb82ed22e 100644
--- a/compiler/hsSyn/HsPat.hs-boot
+++ b/compiler/hsSyn/HsPat.hs-boot
@@ -10,11 +10,11 @@ import SrcLoc( Located )
import Data.Data hiding (Fixity)
import Outputable
-import PlaceHolder ( DataId, OutputableBndrId )
+import HsExtension ( SourceTextX, DataId, OutputableBndrId )
type role Pat nominal
data Pat (i :: *)
type LPat i = Located (Pat i)
-instance (DataId id) => Data (Pat id)
-instance (OutputableBndrId name) => Outputable (Pat name)
+instance (DataId p) => Data (Pat p)
+instance (SourceTextX pass, OutputableBndrId pass) => Outputable (Pat pass)
diff --git a/compiler/hsSyn/HsSyn.hs b/compiler/hsSyn/HsSyn.hs
index e7cae91572..76afa8b81e 100644
--- a/compiler/hsSyn/HsSyn.hs
+++ b/compiler/hsSyn/HsSyn.hs
@@ -27,6 +27,7 @@ module HsSyn (
module HsUtils,
module HsDoc,
module PlaceHolder,
+ module HsExtension,
Fixity,
HsModule(..)
@@ -39,12 +40,12 @@ import HsExpr
import HsImpExp
import HsLit
import PlaceHolder
+import HsExtension
import HsPat
import HsTypes
import BasicTypes ( Fixity, WarningTxt )
import HsUtils
import HsDoc
-import OccName ( HasOccName(..) )
-- others:
import Outputable
@@ -109,8 +110,8 @@ data HsModule name
-- For details on above see note [Api annotations] in ApiAnnotation
deriving instance (DataId name) => Data (HsModule name)
-instance (OutputableBndrId name, HasOccName name)
- => Outputable (HsModule name) where
+instance (SourceTextX pass, OutputableBndrId pass)
+ => Outputable (HsModule pass) where
ppr (HsModule Nothing _ imports decls _ mbDoc)
= pp_mb mbDoc $$ pp_nonnull imports
diff --git a/compiler/hsSyn/HsTypes.hs b/compiler/hsSyn/HsTypes.hs
index 9d7efc5bb5..77b1439efb 100644
--- a/compiler/hsSyn/HsTypes.hs
+++ b/compiler/hsSyn/HsTypes.hs
@@ -70,8 +70,8 @@ module HsTypes (
import {-# SOURCE #-} HsExpr ( HsSplice, pprSplice )
-import PlaceHolder ( PostTc,PostRn,DataId,PlaceHolder(..),
- OutputableBndrId )
+import PlaceHolder ( PlaceHolder(..) )
+import HsExtension
import Id ( Id )
import Name( Name )
@@ -101,10 +101,10 @@ import Control.Monad ( unless )
-}
-- | Located Bang Type
-type LBangType name = Located (BangType name)
+type LBangType pass = Located (BangType pass)
-- | Bang Type
-type BangType name = HsType name -- Bangs are in the HsType data type
+type BangType pass = HsType pass -- Bangs are in the HsType data type
getBangType :: LHsType a -> LHsType a
getBangType (L _ (HsBangTy _ ty)) = ty
@@ -219,26 +219,26 @@ Note carefully:
-}
-- | Located Haskell Context
-type LHsContext name = Located (HsContext name)
+type LHsContext pass = Located (HsContext pass)
-- ^ 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnUnit'
-- For details on above see note [Api annotations] in ApiAnnotation
-- | Haskell Context
-type HsContext name = [LHsType name]
+type HsContext pass = [LHsType pass]
-- | Located Haskell Type
-type LHsType name = Located (HsType name)
+type LHsType pass = Located (HsType pass)
-- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnComma' when
-- in a list
-- For details on above see note [Api annotations] in ApiAnnotation
-- | Haskell Kind
-type HsKind name = HsType name
+type HsKind pass = HsType pass
-- | Located Haskell Kind
-type LHsKind name = Located (HsKind name)
+type LHsKind pass = Located (HsKind pass)
-- ^ 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDcolon'
-- For details on above see note [Api annotations] in ApiAnnotation
@@ -248,32 +248,33 @@ type LHsKind name = Located (HsKind name)
-- The explicitly-quantified binders in a data/type declaration
-- | Located Haskell Type Variable Binder
-type LHsTyVarBndr name = Located (HsTyVarBndr name)
+type LHsTyVarBndr pass = Located (HsTyVarBndr pass)
-- See Note [HsType binders]
-- | Located Haskell Quantified Type Variables
-data LHsQTyVars name -- See Note [HsType binders]
- = HsQTvs { hsq_implicit :: PostRn name [Name] -- implicit (dependent) variables
- , hsq_explicit :: [LHsTyVarBndr name] -- explicit variables
+data LHsQTyVars pass -- See Note [HsType binders]
+ = HsQTvs { hsq_implicit :: PostRn pass [Name]
+ -- implicit (dependent) variables
+ , hsq_explicit :: [LHsTyVarBndr pass] -- explicit variables
-- See Note [HsForAllTy tyvar binders]
- , hsq_dependent :: PostRn name NameSet
+ , hsq_dependent :: PostRn pass NameSet
-- which explicit vars are dependent
-- See Note [Dependent LHsQTyVars] in TcHsType
}
-deriving instance (DataId name) => Data (LHsQTyVars name)
+deriving instance (DataId pass) => Data (LHsQTyVars pass)
-mkHsQTvs :: [LHsTyVarBndr RdrName] -> LHsQTyVars RdrName
+mkHsQTvs :: [LHsTyVarBndr GhcPs] -> LHsQTyVars GhcPs
mkHsQTvs tvs = HsQTvs { hsq_implicit = PlaceHolder, hsq_explicit = tvs
, hsq_dependent = PlaceHolder }
-hsQTvExplicit :: LHsQTyVars name -> [LHsTyVarBndr name]
+hsQTvExplicit :: LHsQTyVars pass -> [LHsTyVarBndr pass]
hsQTvExplicit = hsq_explicit
-emptyLHsQTvs :: LHsQTyVars Name
+emptyLHsQTvs :: LHsQTyVars GhcRn
emptyLHsQTvs = HsQTvs [] [] emptyNameSet
-isEmptyLHsQTvs :: LHsQTyVars Name -> Bool
+isEmptyLHsQTvs :: LHsQTyVars GhcRn -> Bool
isEmptyLHsQTvs (HsQTvs [] [] _) = True
isEmptyLHsQTvs _ = False
@@ -287,19 +288,20 @@ isEmptyLHsQTvs _ = False
-- In the last of these, wildcards can happen, so we must accommodate them
-- | Haskell Implicit Binders
-data HsImplicitBndrs name thing -- See Note [HsType binders]
- = HsIB { hsib_vars :: PostRn name [Name] -- Implicitly-bound kind & type vars
+data HsImplicitBndrs pass thing -- See Note [HsType binders]
+ = HsIB { hsib_vars :: PostRn pass [Name] -- Implicitly-bound kind & type vars
, hsib_body :: thing -- Main payload (type or list of types)
- , hsib_closed :: PostRn name Bool -- Taking the hsib_vars into account,
+ , hsib_closed :: PostRn pass Bool -- Taking the hsib_vars into account,
-- is the payload closed? Used in
-- TcHsType.decideKindGeneralisationPlan
}
+deriving instance (DataId pass, Data thing) => Data (HsImplicitBndrs pass thing)
-- | Haskell Wildcard Binders
-data HsWildCardBndrs name thing
+data HsWildCardBndrs pass thing
-- See Note [HsType binders]
-- See Note [The wildcard story for types]
- = HsWC { hswc_wcs :: PostRn name [Name]
+ = HsWC { hswc_wcs :: PostRn pass [Name]
-- Wild cards, both named and anonymous
-- after the renamer
@@ -309,33 +311,29 @@ data HsWildCardBndrs name thing
-- it's still there in the hsc_body.
}
-deriving instance (Data name, Data thing, Data (PostRn name [Name]), Data (PostRn name Bool))
- => Data (HsImplicitBndrs name thing)
-
-deriving instance (Data name, Data thing, Data (PostRn name [Name]))
- => Data (HsWildCardBndrs name thing)
+deriving instance (DataId pass, Data thing) => Data (HsWildCardBndrs pass thing)
-- | Located Haskell Signature Type
-type LHsSigType name = HsImplicitBndrs name (LHsType name) -- Implicit only
+type LHsSigType pass = HsImplicitBndrs pass (LHsType pass) -- Implicit only
-- | Located Haskell Wildcard Type
-type LHsWcType name = HsWildCardBndrs name (LHsType name) -- Wildcard only
+type LHsWcType pass = HsWildCardBndrs pass (LHsType pass) -- Wildcard only
-- | Located Haskell Signature Wildcard Type
-type LHsSigWcType name = HsWildCardBndrs name (LHsSigType name) -- Both
+type LHsSigWcType pass = HsWildCardBndrs pass (LHsSigType pass) -- Both
-- See Note [Representing type signatures]
-hsImplicitBody :: HsImplicitBndrs name thing -> thing
+hsImplicitBody :: HsImplicitBndrs pass thing -> thing
hsImplicitBody (HsIB { hsib_body = body }) = body
-hsSigType :: LHsSigType name -> LHsType name
+hsSigType :: LHsSigType pass -> LHsType pass
hsSigType = hsImplicitBody
-hsSigWcType :: LHsSigWcType name -> LHsType name
+hsSigWcType :: LHsSigWcType pass -> LHsType pass
hsSigWcType sig_ty = hsib_body (hswc_body sig_ty)
-dropWildCards :: LHsSigWcType name -> LHsSigType name
+dropWildCards :: LHsSigWcType pass -> LHsSigType pass
-- Drop the wildcard part of a LHsSigWcType
dropWildCards sig_ty = hswc_body sig_ty
@@ -359,23 +357,23 @@ The implicit kind variable 'k' is bound by the HsIB;
the explicitly forall'd tyvar 'a' is bound by the HsForAllTy
-}
-mkHsImplicitBndrs :: thing -> HsImplicitBndrs RdrName thing
+mkHsImplicitBndrs :: thing -> HsImplicitBndrs GhcPs thing
mkHsImplicitBndrs x = HsIB { hsib_body = x
, hsib_vars = PlaceHolder
, hsib_closed = PlaceHolder }
-mkHsWildCardBndrs :: thing -> HsWildCardBndrs RdrName thing
+mkHsWildCardBndrs :: thing -> HsWildCardBndrs GhcPs thing
mkHsWildCardBndrs x = HsWC { hswc_body = x
, hswc_wcs = PlaceHolder }
-- Add empty binders. This is a bit suspicious; what if
-- the wrapped thing had free type variables?
-mkEmptyImplicitBndrs :: thing -> HsImplicitBndrs Name thing
+mkEmptyImplicitBndrs :: thing -> HsImplicitBndrs GhcRn thing
mkEmptyImplicitBndrs x = HsIB { hsib_body = x
, hsib_vars = []
, hsib_closed = False }
-mkEmptyWildCardBndrs :: thing -> HsWildCardBndrs Name thing
+mkEmptyWildCardBndrs :: thing -> HsWildCardBndrs GhcRn thing
mkEmptyWildCardBndrs x = HsWC { hswc_body = x
, hswc_wcs = [] }
@@ -400,46 +398,47 @@ instance OutputableBndr HsIPName where
--------------------------------------------------
-- | Haskell Type Variable Binder
-data HsTyVarBndr name
+data HsTyVarBndr pass
= UserTyVar -- no explicit kinding
- (Located name)
+ (Located (IdP pass))
-- See Note [Located RdrNames] in HsExpr
| KindedTyVar
- (Located name)
- (LHsKind name) -- The user-supplied kind signature
+ (Located (IdP pass))
+ (LHsKind pass) -- The user-supplied kind signature
-- ^
-- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
-- 'ApiAnnotation.AnnDcolon', 'ApiAnnotation.AnnClose'
-- For details on above see note [Api annotations] in ApiAnnotation
-deriving instance (DataId name) => Data (HsTyVarBndr name)
+deriving instance (DataId pass) => Data (HsTyVarBndr pass)
-- | Does this 'HsTyVarBndr' come with an explicit kind annotation?
-isHsKindedTyVar :: HsTyVarBndr name -> Bool
+isHsKindedTyVar :: HsTyVarBndr pass -> Bool
isHsKindedTyVar (UserTyVar {}) = False
isHsKindedTyVar (KindedTyVar {}) = True
-- | Do all type variables in this 'LHsQTyVars' come with kind annotations?
-hsTvbAllKinded :: LHsQTyVars name -> Bool
+hsTvbAllKinded :: LHsQTyVars pass -> Bool
hsTvbAllKinded = all (isHsKindedTyVar . unLoc) . hsQTvExplicit
-- | Haskell Type
-data HsType name
+data HsType pass
= HsForAllTy -- See Note [HsType binders]
- { hst_bndrs :: [LHsTyVarBndr name] -- Explicit, user-supplied 'forall a b c'
- , hst_body :: LHsType name -- body type
+ { hst_bndrs :: [LHsTyVarBndr pass]
+ -- Explicit, user-supplied 'forall a b c'
+ , hst_body :: LHsType pass -- body type
}
-- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnForall',
-- 'ApiAnnotation.AnnDot','ApiAnnotation.AnnDarrow'
-- For details on above see note [Api annotations] in ApiAnnotation
| HsQualTy -- See Note [HsType binders]
- { hst_ctxt :: LHsContext name -- Context C => blah
- , hst_body :: LHsType name }
+ { hst_ctxt :: LHsContext pass -- Context C => blah
+ , hst_body :: LHsType pass }
| HsTyVar Promoted -- whether explicitly promoted, for the pretty
-- printer
- (Located name)
+ (Located (IdP pass))
-- Type variable, type constructor, or data constructor
-- see Note [Promotions (HsTyVar)]
-- See Note [Located RdrNames] in HsExpr
@@ -447,53 +446,53 @@ data HsType name
-- For details on above see note [Api annotations] in ApiAnnotation
- | HsAppsTy [LHsAppType name] -- Used only before renaming,
+ | HsAppsTy [LHsAppType pass] -- Used only before renaming,
-- Note [HsAppsTy]
-- ^ - 'ApiAnnotation.AnnKeywordId' : None
- | HsAppTy (LHsType name)
- (LHsType name)
+ | HsAppTy (LHsType pass)
+ (LHsType pass)
-- ^ - 'ApiAnnotation.AnnKeywordId' : None
-- For details on above see note [Api annotations] in ApiAnnotation
- | HsFunTy (LHsType name) -- function type
- (LHsType name)
+ | HsFunTy (LHsType pass) -- function type
+ (LHsType pass)
-- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnRarrow',
-- For details on above see note [Api annotations] in ApiAnnotation
- | HsListTy (LHsType name) -- Element type
+ | HsListTy (LHsType pass) -- Element type
-- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'['@,
-- 'ApiAnnotation.AnnClose' @']'@
-- For details on above see note [Api annotations] in ApiAnnotation
- | HsPArrTy (LHsType name) -- Elem. type of parallel array: [:t:]
+ | HsPArrTy (LHsType pass) -- Elem. type of parallel array: [:t:]
-- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'[:'@,
-- 'ApiAnnotation.AnnClose' @':]'@
-- For details on above see note [Api annotations] in ApiAnnotation
| HsTupleTy HsTupleSort
- [LHsType name] -- Element types (length gives arity)
+ [LHsType pass] -- Element types (length gives arity)
-- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'(' or '(#'@,
-- 'ApiAnnotation.AnnClose' @')' or '#)'@
-- For details on above see note [Api annotations] in ApiAnnotation
- | HsSumTy [LHsType name] -- Element types (length gives arity)
+ | HsSumTy [LHsType pass] -- Element types (length gives arity)
-- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'(#'@,
-- 'ApiAnnotation.AnnClose' '#)'@
-- For details on above see note [Api annotations] in ApiAnnotation
- | HsOpTy (LHsType name) (Located name) (LHsType name)
+ | HsOpTy (LHsType pass) (Located (IdP pass)) (LHsType pass)
-- ^ - 'ApiAnnotation.AnnKeywordId' : None
-- For details on above see note [Api annotations] in ApiAnnotation
- | HsParTy (LHsType name) -- See Note [Parens in HsSyn] in HsExpr
+ | HsParTy (LHsType pass) -- See Note [Parens in HsSyn] in HsExpr
-- Parenthesis preserved for the precedence re-arrangement in RnTypes
-- It's important that a * (b + c) doesn't get rearranged to (a*b) + c!
-- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'('@,
@@ -502,7 +501,8 @@ data HsType name
-- For details on above see note [Api annotations] in ApiAnnotation
| HsIParamTy (Located HsIPName) -- (?x :: ty)
- (LHsType name) -- Implicit parameters as they occur in contexts
+ (LHsType pass) -- Implicit parameters as they occur in
+ -- contexts
-- ^
-- > (?x :: ty)
--
@@ -510,8 +510,10 @@ data HsType name
-- For details on above see note [Api annotations] in ApiAnnotation
- | HsEqTy (LHsType name) -- ty1 ~ ty2
- (LHsType name) -- Always allowed even without TypeOperators, and has special kinding rule
+ | HsEqTy (LHsType pass) -- ty1 ~ ty2
+ (LHsType pass) -- Always allowed even without
+ -- TypeOperators, and has special
+ -- kinding rule
-- ^
-- > ty1 ~ ty2
--
@@ -519,8 +521,8 @@ data HsType name
-- For details on above see note [Api annotations] in ApiAnnotation
- | HsKindSig (LHsType name) -- (ty :: kind)
- (LHsKind name) -- A type with a kind signature
+ | HsKindSig (LHsType pass) -- (ty :: kind)
+ (LHsKind pass) -- A type with a kind signature
-- ^
-- > (ty :: kind)
--
@@ -529,19 +531,19 @@ data HsType name
-- For details on above see note [Api annotations] in ApiAnnotation
- | HsSpliceTy (HsSplice name) -- Includes quasi-quotes
- (PostTc name Kind)
+ | HsSpliceTy (HsSplice pass) -- Includes quasi-quotes
+ (PostTc pass Kind)
-- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'$('@,
-- 'ApiAnnotation.AnnClose' @')'@
-- For details on above see note [Api annotations] in ApiAnnotation
- | HsDocTy (LHsType name) LHsDocString -- A documented type
+ | HsDocTy (LHsType pass) LHsDocString -- A documented type
-- ^ - 'ApiAnnotation.AnnKeywordId' : None
-- For details on above see note [Api annotations] in ApiAnnotation
- | HsBangTy HsSrcBang (LHsType name) -- Bang-style type annotations
+ | HsBangTy HsSrcBang (LHsType pass) -- Bang-style type annotations
-- ^ - 'ApiAnnotation.AnnKeywordId' :
-- 'ApiAnnotation.AnnOpen' @'{-\# UNPACK' or '{-\# NOUNPACK'@,
-- 'ApiAnnotation.AnnClose' @'#-}'@
@@ -549,7 +551,7 @@ data HsType name
-- For details on above see note [Api annotations] in ApiAnnotation
- | HsRecTy [LConDeclField name] -- Only in data type declarations
+ | HsRecTy [LConDeclField pass] -- Only in data type declarations
-- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'{'@,
-- 'ApiAnnotation.AnnClose' @'}'@
@@ -563,16 +565,16 @@ data HsType name
| HsExplicitListTy -- A promoted explicit list
Promoted -- whether explcitly promoted, for pretty printer
- (PostTc name Kind) -- See Note [Promoted lists and tuples]
- [LHsType name]
+ (PostTc pass Kind) -- See Note [Promoted lists and tuples]
+ [LHsType pass]
-- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @"'["@,
-- 'ApiAnnotation.AnnClose' @']'@
-- For details on above see note [Api annotations] in ApiAnnotation
| HsExplicitTupleTy -- A promoted explicit tuple
- [PostTc name Kind] -- See Note [Promoted lists and tuples]
- [LHsType name]
+ [PostTc pass Kind] -- See Note [Promoted lists and tuples]
+ [LHsType pass]
-- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @"'("@,
-- 'ApiAnnotation.AnnClose' @')'@
@@ -583,12 +585,12 @@ data HsType name
-- For details on above see note [Api annotations] in ApiAnnotation
- | HsWildCardTy (HsWildCardInfo name) -- A type wildcard
+ | HsWildCardTy (HsWildCardInfo pass) -- A type wildcard
-- See Note [The wildcard story for types]
-- ^ - 'ApiAnnotation.AnnKeywordId' : None
-- For details on above see note [Api annotations] in ApiAnnotation
-deriving instance (DataId name) => Data (HsType name)
+deriving instance (DataId pass) => Data (HsType pass)
-- Note [Literal source text] in BasicTypes for SourceText fields in
-- the following
@@ -598,23 +600,24 @@ data HsTyLit
| HsStrTy SourceText FastString
deriving Data
-newtype HsWildCardInfo name -- See Note [The wildcard story for types]
- = AnonWildCard (PostRn name (Located Name))
+newtype HsWildCardInfo pass -- See Note [The wildcard story for types]
+ = AnonWildCard (PostRn pass (Located Name))
-- A anonymous wild card ('_'). A fresh Name is generated for
-- each individual anonymous wildcard during renaming
-deriving instance (DataId name) => Data (HsWildCardInfo name)
+deriving instance (DataId pass) => Data (HsWildCardInfo pass)
-- | Located Haskell Application Type
-type LHsAppType name = Located (HsAppType name)
+type LHsAppType pass = Located (HsAppType pass)
-- ^ 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSimpleQuote'
-- | Haskell Application Type
-data HsAppType name
- = HsAppInfix (Located name) -- either a symbol or an id in backticks
- | HsAppPrefix (LHsType name) -- anything else, including things like (+)
-deriving instance (DataId name) => Data (HsAppType name)
+data HsAppType pass
+ = HsAppInfix (Located (IdP pass)) -- either a symbol or an id in backticks
+ | HsAppPrefix (LHsType pass) -- anything else, including things like (+)
+deriving instance (DataId pass) => Data (HsAppType pass)
-instance (OutputableBndrId name) => Outputable (HsAppType name) where
+instance (SourceTextX pass, OutputableBndrId pass)
+ => Outputable (HsAppType pass) where
ppr = ppr_app_ty
{-
@@ -741,24 +744,25 @@ data Promoted = Promoted
deriving (Data, Eq, Show)
-- | Located Constructor Declaration Field
-type LConDeclField name = Located (ConDeclField name)
+type LConDeclField pass = Located (ConDeclField pass)
-- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnComma' when
-- in a list
-- For details on above see note [Api annotations] in ApiAnnotation
-- | Constructor Declaration Field
-data ConDeclField name -- Record fields have Haddoc docs on them
- = ConDeclField { cd_fld_names :: [LFieldOcc name],
- -- ^ See Note [ConDeclField names]
- cd_fld_type :: LBangType name,
+data ConDeclField pass -- Record fields have Haddoc docs on them
+ = ConDeclField { cd_fld_names :: [LFieldOcc pass],
+ -- ^ See Note [ConDeclField passs]
+ cd_fld_type :: LBangType pass,
cd_fld_doc :: Maybe LHsDocString }
-- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDcolon'
-- For details on above see note [Api annotations] in ApiAnnotation
-deriving instance (DataId name) => Data (ConDeclField name)
+deriving instance (DataId pass) => Data (ConDeclField pass)
-instance (OutputableBndrId name) => Outputable (ConDeclField name) where
+instance (SourceTextX pass, OutputableBndrId pass)
+ => Outputable (ConDeclField pass) where
ppr (ConDeclField fld_n fld_ty _) = ppr fld_n <+> dcolon <+> ppr fld_ty
-- HsConDetails is used for patterns/expressions *and* for data type
@@ -783,11 +787,11 @@ updateGadtResult
:: (Monad m)
=> (SDoc -> m ())
-> SDoc
- -> HsConDetails (LHsType Name) (Located [LConDeclField Name])
+ -> HsConDetails (LHsType GhcRn) (Located [LConDeclField GhcRn])
-- ^ Original details
- -> LHsType Name -- ^ Original result type
- -> m (HsConDetails (LHsType Name) (Located [LConDeclField Name]),
- LHsType Name)
+ -> LHsType GhcRn -- ^ Original result type
+ -> m (HsConDetails (LHsType GhcRn) (Located [LConDeclField GhcRn]),
+ LHsType GhcRn)
updateGadtResult failWith doc details ty
= do { let (arg_tys, res_ty) = splitHsFunType ty
badConSig = text "Malformed constructor signature"
@@ -801,7 +805,7 @@ updateGadtResult failWith doc details ty
PrefixCon {} -> return (PrefixCon arg_tys, res_ty)}
{-
-Note [ConDeclField names]
+Note [ConDeclField passs]
~~~~~~~~~~~~~~~~~~~~~~~~~
A ConDeclField contains a list of field occurrences: these always
@@ -825,7 +829,7 @@ gives
-- types
---------------------
-hsWcScopedTvs :: LHsSigWcType Name -> [Name]
+hsWcScopedTvs :: LHsSigWcType GhcRn -> [Name]
-- Get the lexically-scoped type variables of a HsSigType
-- - the explicitly-given forall'd type variables
-- - the implicitly-bound kind variables
@@ -841,7 +845,7 @@ hsWcScopedTvs sig_ty
-- (this is consistent with GHC 7 behaviour)
_ -> nwcs
-hsScopedTvs :: LHsSigType Name -> [Name]
+hsScopedTvs :: LHsSigType GhcRn -> [Name]
-- Same as hsWcScopedTvs, but for a LHsSigType
hsScopedTvs sig_ty
| HsIB { hsib_vars = vars, hsib_body = sig_ty2 } <- sig_ty
@@ -864,30 +868,30 @@ I don't know if this is a good idea, but there it is.
-}
---------------------
-hsTyVarName :: HsTyVarBndr name -> name
+hsTyVarName :: HsTyVarBndr pass -> IdP pass
hsTyVarName (UserTyVar (L _ n)) = n
hsTyVarName (KindedTyVar (L _ n) _) = n
-hsLTyVarName :: LHsTyVarBndr name -> name
+hsLTyVarName :: LHsTyVarBndr pass -> IdP pass
hsLTyVarName = hsTyVarName . unLoc
-hsExplicitLTyVarNames :: LHsQTyVars name -> [name]
+hsExplicitLTyVarNames :: LHsQTyVars pass -> [IdP pass]
-- Explicit variables only
hsExplicitLTyVarNames qtvs = map hsLTyVarName (hsQTvExplicit qtvs)
-hsAllLTyVarNames :: LHsQTyVars Name -> [Name]
+hsAllLTyVarNames :: LHsQTyVars GhcRn -> [Name]
-- All variables
hsAllLTyVarNames (HsQTvs { hsq_implicit = kvs, hsq_explicit = tvs })
= kvs ++ map hsLTyVarName tvs
-hsLTyVarLocName :: LHsTyVarBndr name -> Located name
+hsLTyVarLocName :: LHsTyVarBndr pass -> Located (IdP pass)
hsLTyVarLocName = fmap hsTyVarName
-hsLTyVarLocNames :: LHsQTyVars name -> [Located name]
+hsLTyVarLocNames :: LHsQTyVars pass -> [Located (IdP pass)]
hsLTyVarLocNames qtvs = map hsLTyVarLocName (hsQTvExplicit qtvs)
-- | Convert a LHsTyVarBndr to an equivalent LHsType.
-hsLTyVarBndrToType :: LHsTyVarBndr name -> LHsType name
+hsLTyVarBndrToType :: LHsTyVarBndr pass -> LHsType pass
hsLTyVarBndrToType = fmap cvt
where cvt (UserTyVar n) = HsTyVar NotPromoted n
cvt (KindedTyVar (L name_loc n) kind)
@@ -895,19 +899,19 @@ hsLTyVarBndrToType = fmap cvt
-- | Convert a LHsTyVarBndrs to a list of types.
-- Works on *type* variable only, no kind vars.
-hsLTyVarBndrsToTypes :: LHsQTyVars name -> [LHsType name]
+hsLTyVarBndrsToTypes :: LHsQTyVars pass -> [LHsType pass]
hsLTyVarBndrsToTypes (HsQTvs { hsq_explicit = tvbs }) = map hsLTyVarBndrToType tvbs
---------------------
-wildCardName :: HsWildCardInfo Name -> Name
+wildCardName :: HsWildCardInfo GhcRn -> Name
wildCardName (AnonWildCard (L _ n)) = n
-- Two wild cards are the same when they have the same location
-sameWildCard :: Located (HsWildCardInfo name)
- -> Located (HsWildCardInfo name) -> Bool
+sameWildCard :: Located (HsWildCardInfo pass)
+ -> Located (HsWildCardInfo pass) -> Bool
sameWildCard (L l1 (AnonWildCard _)) (L l2 (AnonWildCard _)) = l1 == l2
-ignoreParens :: LHsType name -> LHsType name
+ignoreParens :: LHsType pass -> LHsType pass
ignoreParens (L _ (HsParTy ty)) = ignoreParens ty
ignoreParens (L _ (HsAppsTy [L _ (HsAppPrefix ty)])) = ignoreParens ty
ignoreParens ty = ty
@@ -920,16 +924,16 @@ ignoreParens ty = ty
************************************************************************
-}
-mkAnonWildCardTy :: HsType RdrName
+mkAnonWildCardTy :: HsType GhcPs
mkAnonWildCardTy = HsWildCardTy (AnonWildCard PlaceHolder)
-mkHsOpTy :: LHsType name -> Located name -> LHsType name -> HsType name
+mkHsOpTy :: LHsType pass -> Located (IdP pass) -> LHsType pass -> HsType pass
mkHsOpTy ty1 op ty2 = HsOpTy ty1 op ty2
-mkHsAppTy :: LHsType name -> LHsType name -> LHsType name
+mkHsAppTy :: LHsType pass -> LHsType pass -> LHsType pass
mkHsAppTy t1 t2 = addCLoc t1 t2 (HsAppTy t1 t2)
-mkHsAppTys :: LHsType name -> [LHsType name] -> LHsType name
+mkHsAppTys :: LHsType pass -> [LHsType pass] -> LHsType pass
mkHsAppTys = foldl mkHsAppTy
@@ -947,7 +951,7 @@ mkHsAppTys = foldl mkHsAppTy
-- splitHsFunType (a -> (b -> c)) = ([a,b], c)
-- Also deals with (->) t1 t2; that is why it only works on LHsType Name
-- (see Trac #9096)
-splitHsFunType :: LHsType Name -> ([LHsType Name], LHsType Name)
+splitHsFunType :: LHsType GhcRn -> ([LHsType GhcRn], LHsType GhcRn)
splitHsFunType (L _ (HsParTy ty))
= splitHsFunType ty
@@ -971,8 +975,8 @@ splitHsFunType other = ([], other)
--------------------------------
-- | Retrieves the head of an HsAppsTy, if this can be done unambiguously,
-- without consulting fixities.
-getAppsTyHead_maybe :: [LHsAppType name]
- -> Maybe (LHsType name, [LHsType name], LexicalFixity)
+getAppsTyHead_maybe :: [LHsAppType pass]
+ -> Maybe (LHsType pass, [LHsType pass], LexicalFixity)
getAppsTyHead_maybe tys = case splitHsAppsTy tys of
([app1:apps], []) -> -- no symbols, some normal types
Just (mkHsAppTys app1 apps, [], Prefix)
@@ -982,13 +986,13 @@ getAppsTyHead_maybe tys = case splitHsAppsTy tys of
_ -> -- can't figure it out
Nothing
--- | Splits a [HsAppType name] (the payload of an HsAppsTy) into regions of prefix
--- types (normal types) and infix operators.
+-- | Splits a [HsAppType pass] (the payload of an HsAppsTy) into regions of
+-- prefix types (normal types) and infix operators.
-- If @splitHsAppsTy tys = (non_syms, syms)@, then @tys@ starts with the first
-- element of @non_syms@ followed by the first element of @syms@ followed by
-- the next element of @non_syms@, etc. It is guaranteed that the non_syms list
-- has one more element than the syms list.
-splitHsAppsTy :: [LHsAppType name] -> ([[LHsType name]], [Located name])
+splitHsAppsTy :: [LHsAppType pass] -> ([[LHsType pass]], [Located (IdP pass)])
splitHsAppsTy = go [] [] []
where
go acc acc_non acc_sym [] = (reverse (reverse acc : acc_non), reverse acc_sym)
@@ -1001,7 +1005,8 @@ splitHsAppsTy = go [] [] []
-- somewhat like splitHsAppTys, but a little more thorough
-- used to examine the result of a GADT-like datacon, so it doesn't handle
-- *all* cases (like lists, tuples, (~), etc.)
-hsTyGetAppHead_maybe :: LHsType name -> Maybe (Located name, [LHsType name])
+hsTyGetAppHead_maybe :: LHsType pass
+ -> Maybe (Located (IdP pass), [LHsType pass])
hsTyGetAppHead_maybe = go []
where
go tys (L _ (HsTyVar _ ln)) = Just (ln, tys)
@@ -1014,19 +1019,20 @@ hsTyGetAppHead_maybe = go []
go tys (L _ (HsKindSig t _)) = go tys t
go _ _ = Nothing
-splitHsAppTys :: LHsType Name -> [LHsType Name] -> (LHsType Name, [LHsType Name])
+splitHsAppTys :: LHsType GhcRn -> [LHsType GhcRn]
+ -> (LHsType GhcRn, [LHsType GhcRn])
-- no need to worry about HsAppsTy here
splitHsAppTys (L _ (HsAppTy f a)) as = splitHsAppTys f (a:as)
splitHsAppTys (L _ (HsParTy f)) as = splitHsAppTys f as
splitHsAppTys f as = (f,as)
--------------------------------
-splitLHsPatSynTy :: LHsType name
- -> ( [LHsTyVarBndr name] -- universals
- , LHsContext name -- required constraints
- , [LHsTyVarBndr name] -- existentials
- , LHsContext name -- provided constraints
- , LHsType name) -- body type
+splitLHsPatSynTy :: LHsType pass
+ -> ( [LHsTyVarBndr pass] -- universals
+ , LHsContext pass -- required constraints
+ , [LHsTyVarBndr pass] -- existentials
+ , LHsContext pass -- provided constraints
+ , LHsType pass) -- body type
splitLHsPatSynTy ty = (univs, reqs, exis, provs, ty4)
where
(univs, ty1) = splitLHsForAllTy ty
@@ -1034,22 +1040,23 @@ splitLHsPatSynTy ty = (univs, reqs, exis, provs, ty4)
(exis, ty3) = splitLHsForAllTy ty2
(provs, ty4) = splitLHsQualTy ty3
-splitLHsSigmaTy :: LHsType name -> ([LHsTyVarBndr name], LHsContext name, LHsType name)
+splitLHsSigmaTy :: LHsType pass
+ -> ([LHsTyVarBndr pass], LHsContext pass, LHsType pass)
splitLHsSigmaTy ty
| (tvs, ty1) <- splitLHsForAllTy ty
, (ctxt, ty2) <- splitLHsQualTy ty1
= (tvs, ctxt, ty2)
-splitLHsForAllTy :: LHsType name -> ([LHsTyVarBndr name], LHsType name)
+splitLHsForAllTy :: LHsType pass -> ([LHsTyVarBndr pass], LHsType pass)
splitLHsForAllTy (L _ (HsForAllTy { hst_bndrs = tvs, hst_body = body })) = (tvs, body)
splitLHsForAllTy body = ([], body)
-splitLHsQualTy :: LHsType name -> (LHsContext name, LHsType name)
+splitLHsQualTy :: LHsType pass -> (LHsContext pass, LHsType pass)
splitLHsQualTy (L _ (HsQualTy { hst_ctxt = ctxt, hst_body = body })) = (ctxt, body)
splitLHsQualTy body = (noLoc [], body)
-splitLHsInstDeclTy :: LHsSigType Name
- -> ([Name], LHsContext Name, LHsType Name)
+splitLHsInstDeclTy :: LHsSigType GhcRn
+ -> ([Name], LHsContext GhcRn, LHsType GhcRn)
-- Split up an instance decl type, returning the pieces
splitLHsInstDeclTy (HsIB { hsib_vars = itkvs
, hsib_body = inst_ty })
@@ -1058,12 +1065,12 @@ splitLHsInstDeclTy (HsIB { hsib_vars = itkvs
-- Return implicitly bound type and kind vars
-- For an instance decl, all of them are in scope
-getLHsInstDeclHead :: LHsSigType name -> LHsType name
+getLHsInstDeclHead :: LHsSigType pass -> LHsType pass
getLHsInstDeclHead inst_ty
| (_tvs, _cxt, body_ty) <- splitLHsSigmaTy (hsSigType inst_ty)
= body_ty
-getLHsInstDeclClass_maybe :: LHsSigType name -> Maybe (Located name)
+getLHsInstDeclClass_maybe :: LHsSigType pass -> Maybe (Located (IdP pass))
-- Works on (HsSigType RdrName)
getLHsInstDeclClass_maybe inst_ty
= do { let head_ty = getLHsInstDeclHead inst_ty
@@ -1079,25 +1086,25 @@ getLHsInstDeclClass_maybe inst_ty
-}
-- | Located Field Occurrence
-type LFieldOcc name = Located (FieldOcc name)
+type LFieldOcc pass = Located (FieldOcc pass)
-- | Field Occurrence
--
-- Represents an *occurrence* of an unambiguous field. We store
-- both the 'RdrName' the user originally wrote, and after the
-- renamer, the selector function.
-data FieldOcc name = FieldOcc { rdrNameFieldOcc :: Located RdrName
+data FieldOcc pass = FieldOcc { rdrNameFieldOcc :: Located RdrName
-- ^ See Note [Located RdrNames] in HsExpr
- , selectorFieldOcc :: PostRn name name
+ , selectorFieldOcc :: PostRn pass (IdP pass)
}
-deriving instance Eq (PostRn name name) => Eq (FieldOcc name)
-deriving instance Ord (PostRn name name) => Ord (FieldOcc name)
-deriving instance (Data name, Data (PostRn name name)) => Data (FieldOcc name)
+deriving instance Eq (PostRn pass (IdP pass)) => Eq (FieldOcc pass)
+deriving instance Ord (PostRn pass (IdP pass)) => Ord (FieldOcc pass)
+deriving instance (DataId pass) => Data (FieldOcc pass)
-instance Outputable (FieldOcc name) where
+instance Outputable (FieldOcc pass) where
ppr = ppr . rdrNameFieldOcc
-mkFieldOcc :: Located RdrName -> FieldOcc RdrName
+mkFieldOcc :: Located RdrName -> FieldOcc GhcPs
mkFieldOcc rdr = FieldOcc rdr PlaceHolder
@@ -1113,37 +1120,37 @@ mkFieldOcc rdr = FieldOcc rdr PlaceHolder
-- See Note [HsRecField and HsRecUpdField] in HsPat and
-- Note [Disambiguating record fields] in TcExpr.
-- See Note [Located RdrNames] in HsExpr
-data AmbiguousFieldOcc name
- = Unambiguous (Located RdrName) (PostRn name name)
- | Ambiguous (Located RdrName) (PostTc name name)
-deriving instance ( Data name
- , Data (PostRn name name)
- , Data (PostTc name name))
- => Data (AmbiguousFieldOcc name)
-
-instance Outputable (AmbiguousFieldOcc name) where
+data AmbiguousFieldOcc pass
+ = Unambiguous (Located RdrName) (PostRn pass (IdP pass))
+ | Ambiguous (Located RdrName) (PostTc pass (IdP pass))
+deriving instance ( Data pass
+ , Data (PostTc pass (IdP pass))
+ , Data (PostRn pass (IdP pass)))
+ => Data (AmbiguousFieldOcc pass)
+
+instance Outputable (AmbiguousFieldOcc pass) where
ppr = ppr . rdrNameAmbiguousFieldOcc
-instance OutputableBndr (AmbiguousFieldOcc name) where
+instance OutputableBndr (AmbiguousFieldOcc pass) where
pprInfixOcc = pprInfixOcc . rdrNameAmbiguousFieldOcc
pprPrefixOcc = pprPrefixOcc . rdrNameAmbiguousFieldOcc
-mkAmbiguousFieldOcc :: Located RdrName -> AmbiguousFieldOcc RdrName
+mkAmbiguousFieldOcc :: Located RdrName -> AmbiguousFieldOcc GhcPs
mkAmbiguousFieldOcc rdr = Unambiguous rdr PlaceHolder
-rdrNameAmbiguousFieldOcc :: AmbiguousFieldOcc name -> RdrName
+rdrNameAmbiguousFieldOcc :: AmbiguousFieldOcc pass -> RdrName
rdrNameAmbiguousFieldOcc (Unambiguous (L _ rdr) _) = rdr
rdrNameAmbiguousFieldOcc (Ambiguous (L _ rdr) _) = rdr
-selectorAmbiguousFieldOcc :: AmbiguousFieldOcc Id -> Id
+selectorAmbiguousFieldOcc :: AmbiguousFieldOcc GhcTc -> Id
selectorAmbiguousFieldOcc (Unambiguous _ sel) = sel
selectorAmbiguousFieldOcc (Ambiguous _ sel) = sel
-unambiguousFieldOcc :: AmbiguousFieldOcc Id -> FieldOcc Id
+unambiguousFieldOcc :: AmbiguousFieldOcc GhcTc -> FieldOcc GhcTc
unambiguousFieldOcc (Unambiguous rdr sel) = FieldOcc rdr sel
unambiguousFieldOcc (Ambiguous rdr sel) = FieldOcc rdr sel
-ambiguousFieldOcc :: FieldOcc name -> AmbiguousFieldOcc name
+ambiguousFieldOcc :: FieldOcc pass -> AmbiguousFieldOcc pass
ambiguousFieldOcc (FieldOcc rdr sel) = Unambiguous rdr sel
{-
@@ -1154,30 +1161,33 @@ ambiguousFieldOcc (FieldOcc rdr sel) = Unambiguous rdr sel
************************************************************************
-}
-instance (OutputableBndrId name) => Outputable (HsType name) where
+instance (SourceTextX pass, OutputableBndrId pass)
+ => Outputable (HsType pass) where
ppr ty = pprHsType ty
instance Outputable HsTyLit where
ppr = ppr_tylit
-instance (OutputableBndrId name) => Outputable (LHsQTyVars name) where
+instance (SourceTextX pass, OutputableBndrId pass)
+ => Outputable (LHsQTyVars pass) where
ppr (HsQTvs { hsq_explicit = tvs }) = interppSP tvs
-instance (OutputableBndrId name) => Outputable (HsTyVarBndr name) where
+instance (SourceTextX pass, OutputableBndrId pass)
+ => Outputable (HsTyVarBndr pass) where
ppr (UserTyVar n) = ppr n
ppr (KindedTyVar n k) = parens $ hsep [ppr n, dcolon, ppr k]
-instance (Outputable thing) => Outputable (HsImplicitBndrs name thing) where
+instance (Outputable thing) => Outputable (HsImplicitBndrs pass thing) where
ppr (HsIB { hsib_body = ty }) = ppr ty
-instance (Outputable thing) => Outputable (HsWildCardBndrs name thing) where
+instance (Outputable thing) => Outputable (HsWildCardBndrs pass thing) where
ppr (HsWC { hswc_body = ty }) = ppr ty
-instance Outputable (HsWildCardInfo name) where
+instance Outputable (HsWildCardInfo pass) where
ppr (AnonWildCard _) = char '_'
-pprHsForAll :: (OutputableBndrId name)
- => [LHsTyVarBndr name] -> LHsContext name -> SDoc
+pprHsForAll :: (SourceTextX pass, OutputableBndrId pass)
+ => [LHsTyVarBndr pass] -> LHsContext pass -> SDoc
pprHsForAll = pprHsForAllExtra Nothing
-- | Version of 'pprHsForAll' that can also print an extra-constraints
@@ -1187,37 +1197,43 @@ pprHsForAll = pprHsForAllExtra Nothing
-- function for this is needed, as the extra-constraints wildcard is removed
-- from the actual context and type, and stored in a separate field, thus just
-- printing the type will not print the extra-constraints wildcard.
-pprHsForAllExtra :: (OutputableBndrId name)
- => Maybe SrcSpan -> [LHsTyVarBndr name] -> LHsContext name
+pprHsForAllExtra :: (SourceTextX pass, OutputableBndrId pass)
+ => Maybe SrcSpan -> [LHsTyVarBndr pass] -> LHsContext pass
-> SDoc
pprHsForAllExtra extra qtvs cxt
= pprHsForAllTvs qtvs <+> pprHsContextExtra show_extra (unLoc cxt)
where
show_extra = isJust extra
-pprHsForAllTvs :: (OutputableBndrId name) => [LHsTyVarBndr name] -> SDoc
+pprHsForAllTvs :: (SourceTextX pass, OutputableBndrId pass)
+ => [LHsTyVarBndr pass] -> SDoc
pprHsForAllTvs qtvs = sdocWithPprDebug $ \debug ->
ppWhen (debug || not (null qtvs)) $ forAllLit <+> interppSP qtvs <> dot
-pprHsContext :: (OutputableBndrId name) => HsContext name -> SDoc
+pprHsContext :: (SourceTextX pass, OutputableBndrId pass)
+ => HsContext pass -> SDoc
pprHsContext = maybe empty (<+> darrow) . pprHsContextMaybe
-pprHsContextNoArrow :: (OutputableBndrId name) => HsContext name -> SDoc
+pprHsContextNoArrow :: (SourceTextX pass, OutputableBndrId pass)
+ => HsContext pass -> SDoc
pprHsContextNoArrow = fromMaybe empty . pprHsContextMaybe
-pprHsContextMaybe :: (OutputableBndrId name) => HsContext name -> Maybe SDoc
+pprHsContextMaybe :: (SourceTextX pass, OutputableBndrId pass)
+ => HsContext pass -> Maybe SDoc
pprHsContextMaybe [] = Nothing
pprHsContextMaybe [L _ pred] = Just $ ppr_mono_ty pred
pprHsContextMaybe cxt = Just $ parens (interpp'SP cxt)
-- For use in a HsQualTy, which always gets printed if it exists.
-pprHsContextAlways :: (OutputableBndrId name) => HsContext name -> SDoc
+pprHsContextAlways :: (SourceTextX pass, OutputableBndrId pass)
+ => HsContext pass -> SDoc
pprHsContextAlways [] = parens empty <+> darrow
pprHsContextAlways [L _ ty] = ppr_mono_ty ty <+> darrow
pprHsContextAlways cxt = parens (interpp'SP cxt) <+> darrow
-- True <=> print an extra-constraints wildcard, e.g. @(Show a, _) =>@
-pprHsContextExtra :: (OutputableBndrId name) => Bool -> HsContext name -> SDoc
+pprHsContextExtra :: (SourceTextX pass, OutputableBndrId pass)
+ => Bool -> HsContext pass -> SDoc
pprHsContextExtra show_extra ctxt
| not show_extra
= pprHsContext ctxt
@@ -1228,7 +1244,8 @@ pprHsContextExtra show_extra ctxt
where
ctxt' = map ppr ctxt ++ [char '_']
-pprConDeclFields :: (OutputableBndrId name) => [LConDeclField name] -> SDoc
+pprConDeclFields :: (SourceTextX pass, OutputableBndrId pass)
+ => [LConDeclField pass] -> SDoc
pprConDeclFields fields = braces (sep (punctuate comma (map ppr_fld fields)))
where
ppr_fld (L _ (ConDeclField { cd_fld_names = ns, cd_fld_type = ty,
@@ -1252,13 +1269,15 @@ seems like the Right Thing anyway.)
-- Printing works more-or-less as for Types
-pprHsType :: (OutputableBndrId name) => HsType name -> SDoc
+pprHsType :: (SourceTextX pass, OutputableBndrId pass) => HsType pass -> SDoc
pprHsType ty = ppr_mono_ty ty
-ppr_mono_lty :: (OutputableBndrId name) => LHsType name -> SDoc
+ppr_mono_lty :: (SourceTextX pass, OutputableBndrId pass)
+ => LHsType pass -> SDoc
ppr_mono_lty ty = ppr_mono_ty (unLoc ty)
-ppr_mono_ty :: (OutputableBndrId name) => HsType name -> SDoc
+ppr_mono_ty :: (SourceTextX pass, OutputableBndrId pass)
+ => HsType pass -> SDoc
ppr_mono_ty (HsForAllTy { hst_bndrs = tvs, hst_body = ty })
= sep [pprHsForAllTvs tvs, ppr_mono_lty ty]
@@ -1318,8 +1337,8 @@ ppr_mono_ty (HsDocTy ty doc)
-- postfix operators
--------------------------
-ppr_fun_ty :: (OutputableBndrId name)
- => LHsType name -> LHsType name -> SDoc
+ppr_fun_ty :: (SourceTextX pass, OutputableBndrId pass)
+ => LHsType pass -> LHsType pass -> SDoc
ppr_fun_ty ty1 ty2
= let p1 = ppr_mono_lty ty1
p2 = ppr_mono_lty ty2
@@ -1327,7 +1346,8 @@ ppr_fun_ty ty1 ty2
sep [p1, text "->" <+> p2]
--------------------------
-ppr_app_ty :: (OutputableBndrId name) => HsAppType name -> SDoc
+ppr_app_ty :: (SourceTextX pass, OutputableBndrId pass)
+ => HsAppType pass -> SDoc
ppr_app_ty (HsAppInfix (L _ n)) = pprInfixOcc n
ppr_app_ty (HsAppPrefix (L _ (HsTyVar NotPromoted (L _ n))))
= pprPrefixOcc n
diff --git a/compiler/hsSyn/HsUtils.hs b/compiler/hsSyn/HsUtils.hs
index 4b07683a67..c1a9a2f252 100644
--- a/compiler/hsSyn/HsUtils.hs
+++ b/compiler/hsSyn/HsUtils.hs
@@ -6,11 +6,11 @@ Here we collect a variety of helper functions that construct or
analyse HsSyn. All these functions deal with generic HsSyn; functions
which deal with the instantiated versions are located elsewhere:
- Parameterised by Module
- ---------------- -------------
- RdrName parser/RdrHsSyn
- Name rename/RnHsSyn
- Id typecheck/TcHsSyn
+ Parameterised by Module
+ ---------------- -------------
+ GhcPs/RdrName parser/RdrHsSyn
+ GhcRn/Name rename/RnHsSyn
+ GhcTc/Id typecheck/TcHsSyn
-}
{-# LANGUAGE CPP #-}
@@ -99,6 +99,7 @@ import HsPat
import HsTypes
import HsLit
import PlaceHolder
+import HsExtension
import TcEvidence
import RdrName
@@ -140,7 +141,7 @@ just attach noSrcSpan to everything.
mkHsPar :: LHsExpr id -> LHsExpr id
mkHsPar e = L (getLoc e) (HsPar e)
-mkSimpleMatch :: HsMatchContext (NameOrRdrName id)
+mkSimpleMatch :: HsMatchContext (NameOrRdrName (IdP id))
-> [LPat id] -> Located (body id)
-> LMatch id (Located (body id))
mkSimpleMatch ctxt pats rhs
@@ -176,16 +177,16 @@ mkHsApp e1 e2 = addCLoc e1 e2 (HsApp e1 e2)
mkHsAppType :: LHsExpr name -> LHsWcType name -> LHsExpr name
mkHsAppType e t = addCLoc e (hswc_body t) (HsAppType e t)
-mkHsAppTypeOut :: LHsExpr Id -> LHsWcType Name -> LHsExpr Id
+mkHsAppTypeOut :: LHsExpr GhcTc -> LHsWcType GhcRn -> LHsExpr GhcTc
mkHsAppTypeOut e t = addCLoc e (hswc_body t) (HsAppTypeOut e t)
-mkHsLam :: [LPat RdrName] -> LHsExpr RdrName -> LHsExpr RdrName
+mkHsLam :: [LPat GhcPs] -> LHsExpr GhcPs -> LHsExpr GhcPs
mkHsLam pats body = mkHsPar (L (getLoc body) (HsLam matches))
where
matches = mkMatchGroup Generated
[mkSimpleMatch LambdaExpr pats body]
-mkHsLams :: [TyVar] -> [EvVar] -> LHsExpr Id -> LHsExpr Id
+mkHsLams :: [TyVar] -> [EvVar] -> LHsExpr GhcTc -> LHsExpr GhcTc
mkHsLams tyvars dicts expr = mkLHsWrap (mkWpTyLams tyvars
<.> mkWpLams dicts) expr
@@ -195,10 +196,10 @@ mkHsCaseAlt :: LPat id -> (Located (body id)) -> LMatch id (Located (body id))
mkHsCaseAlt pat expr
= mkSimpleMatch CaseAlt [pat] expr
-nlHsTyApp :: name -> [Type] -> LHsExpr name
+nlHsTyApp :: IdP name -> [Type] -> LHsExpr name
nlHsTyApp fun_id tys = noLoc (mkHsWrap (mkWpTyApps tys) (HsVar (noLoc fun_id)))
-nlHsTyApps :: name -> [Type] -> [LHsExpr name] -> LHsExpr name
+nlHsTyApps :: IdP name -> [Type] -> [LHsExpr name] -> LHsExpr name
nlHsTyApps fun_id tys xs = foldl nlHsApp (nlHsTyApp fun_id tys) xs
--------- Adding parens ---------
@@ -219,30 +220,33 @@ nlParPat p = noLoc (ParPat p)
-- These are the bits of syntax that contain rebindable names
-- See RnEnv.lookupSyntaxName
-mkHsIntegral :: IntegralLit -> PostTc RdrName Type
- -> HsOverLit RdrName
-mkHsFractional :: FractionalLit -> PostTc RdrName Type -> HsOverLit RdrName
-mkHsIsString :: SourceText -> FastString -> PostTc RdrName Type
- -> HsOverLit RdrName
-mkHsDo :: HsStmtContext Name -> [ExprLStmt RdrName] -> HsExpr RdrName
-mkHsComp :: HsStmtContext Name -> [ExprLStmt RdrName] -> LHsExpr RdrName
- -> HsExpr RdrName
-
-mkNPat :: Located (HsOverLit RdrName) -> Maybe (SyntaxExpr RdrName) -> Pat RdrName
-mkNPlusKPat :: Located RdrName -> Located (HsOverLit RdrName) -> Pat RdrName
-
-mkLastStmt :: Located (bodyR idR) -> StmtLR idL idR (Located (bodyR idR))
-mkBodyStmt :: Located (bodyR RdrName)
- -> StmtLR idL RdrName (Located (bodyR RdrName))
-mkBindStmt :: (PostTc idR Type ~ PlaceHolder)
+mkHsIntegral :: IntegralLit -> PostTc GhcPs Type
+ -> HsOverLit GhcPs
+mkHsFractional :: FractionalLit -> PostTc GhcPs Type -> HsOverLit GhcPs
+mkHsIsString :: SourceText -> FastString -> PostTc GhcPs Type
+ -> HsOverLit GhcPs
+mkHsDo :: HsStmtContext Name -> [ExprLStmt GhcPs] -> HsExpr GhcPs
+mkHsComp :: HsStmtContext Name -> [ExprLStmt GhcPs] -> LHsExpr GhcPs
+ -> HsExpr GhcPs
+
+mkNPat :: Located (HsOverLit GhcPs) -> Maybe (SyntaxExpr GhcPs)
+ -> Pat GhcPs
+mkNPlusKPat :: Located RdrName -> Located (HsOverLit GhcPs) -> Pat GhcPs
+
+mkLastStmt :: SourceTextX idR
+ => Located (bodyR idR) -> StmtLR idL idR (Located (bodyR idR))
+mkBodyStmt :: Located (bodyR GhcPs)
+ -> StmtLR idL GhcPs (Located (bodyR GhcPs))
+mkBindStmt :: (SourceTextX idR, PostTc idR Type ~ PlaceHolder)
=> LPat idL -> Located (bodyR idR)
-> StmtLR idL idR (Located (bodyR idR))
-mkTcBindStmt :: LPat Id -> Located (bodyR Id) -> StmtLR Id Id (Located (bodyR Id))
+mkTcBindStmt :: LPat GhcTc -> Located (bodyR GhcTc)
+ -> StmtLR GhcTc GhcTc (Located (bodyR GhcTc))
-emptyRecStmt :: StmtLR idL RdrName bodyR
-emptyRecStmtName :: StmtLR Name Name bodyR
-emptyRecStmtId :: StmtLR Id Id bodyR
-mkRecStmt :: [LStmtLR idL RdrName bodyR] -> StmtLR idL RdrName bodyR
+emptyRecStmt :: StmtLR idL GhcPs bodyR
+emptyRecStmtName :: StmtLR GhcRn GhcRn bodyR
+emptyRecStmtId :: StmtLR GhcTc GhcTc bodyR
+mkRecStmt :: [LStmtLR idL GhcPs bodyR] -> StmtLR idL GhcPs bodyR
mkHsIntegral i = OverLit (HsIntegral i) noRebindableInfo noExpr
@@ -257,26 +261,27 @@ mkHsComp ctxt stmts expr = mkHsDo ctxt (stmts ++ [last_stmt])
where
last_stmt = L (getLoc expr) $ mkLastStmt expr
-mkHsIf :: LHsExpr id -> LHsExpr id -> LHsExpr id -> HsExpr id
+mkHsIf :: SourceTextX p => LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
mkHsIf c a b = HsIf (Just noSyntaxExpr) c a b
mkNPat lit neg = NPat lit neg noSyntaxExpr placeHolderType
mkNPlusKPat id lit = NPlusKPat id lit (unLoc lit) noSyntaxExpr noSyntaxExpr placeHolderType
-mkTransformStmt :: (PostTc idR Type ~ PlaceHolder)
+mkTransformStmt :: (SourceTextX idR, PostTc idR Type ~ PlaceHolder)
=> [ExprLStmt idL] -> LHsExpr idR
-> StmtLR idL idR (LHsExpr idL)
-mkTransformByStmt :: (PostTc idR Type ~ PlaceHolder)
+mkTransformByStmt :: (SourceTextX idR, PostTc idR Type ~ PlaceHolder)
=> [ExprLStmt idL] -> LHsExpr idR -> LHsExpr idR
-> StmtLR idL idR (LHsExpr idL)
-mkGroupUsingStmt :: (PostTc idR Type ~ PlaceHolder)
+mkGroupUsingStmt :: (SourceTextX idR, PostTc idR Type ~ PlaceHolder)
=> [ExprLStmt idL] -> LHsExpr idR
-> StmtLR idL idR (LHsExpr idL)
-mkGroupByUsingStmt :: (PostTc idR Type ~ PlaceHolder)
+mkGroupByUsingStmt :: (SourceTextX idR, PostTc idR Type ~ PlaceHolder)
=> [ExprLStmt idL] -> LHsExpr idR -> LHsExpr idR
-> StmtLR idL idR (LHsExpr idL)
-emptyTransStmt :: (PostTc idR Type ~ PlaceHolder) => StmtLR idL idR (LHsExpr idR)
+emptyTransStmt :: (SourceTextX idR, PostTc idR Type ~ PlaceHolder)
+ => StmtLR idL idR (LHsExpr idR)
emptyTransStmt = TransStmt { trS_form = panic "emptyTransStmt: form"
, trS_stmts = [], trS_bndrs = []
, trS_by = Nothing, trS_using = noLoc noExpr
@@ -294,7 +299,7 @@ mkBindStmt pat body = BindStmt pat body noSyntaxExpr noSyntaxExpr PlaceHolder
mkTcBindStmt pat body = BindStmt pat body noSyntaxExpr noSyntaxExpr unitTy
-- don't use placeHolderTypeTc above, because that panics during zonking
-emptyRecStmt' :: forall idL idR body.
+emptyRecStmt' :: forall idL idR body. SourceTextX idR =>
PostTc idR Type -> StmtLR idL idR body
emptyRecStmt' tyVal =
RecStmt
@@ -314,27 +319,27 @@ mkRecStmt stmts = emptyRecStmt { recS_stmts = stmts }
-------------------------------
--- A useful function for building @OpApps@. The operator is always a
-- variable, and we don't know the fixity yet.
-mkHsOpApp :: LHsExpr id -> id -> LHsExpr id -> HsExpr id
+mkHsOpApp :: LHsExpr id -> IdP id -> LHsExpr id -> HsExpr id
mkHsOpApp e1 op e2 = OpApp e1 (noLoc (HsVar (noLoc op)))
(error "mkOpApp:fixity") e2
unqualSplice :: RdrName
unqualSplice = mkRdrUnqual (mkVarOccFS (fsLit "splice"))
-mkUntypedSplice :: SpliceDecoration -> LHsExpr RdrName -> HsSplice RdrName
+mkUntypedSplice :: SpliceDecoration -> LHsExpr GhcPs -> HsSplice GhcPs
mkUntypedSplice hasParen e = HsUntypedSplice hasParen unqualSplice e
-mkHsSpliceE :: SpliceDecoration -> LHsExpr RdrName -> HsExpr RdrName
+mkHsSpliceE :: SpliceDecoration -> LHsExpr GhcPs -> HsExpr GhcPs
mkHsSpliceE hasParen e = HsSpliceE (mkUntypedSplice hasParen e)
-mkHsSpliceTE :: SpliceDecoration -> LHsExpr RdrName -> HsExpr RdrName
+mkHsSpliceTE :: SpliceDecoration -> LHsExpr GhcPs -> HsExpr GhcPs
mkHsSpliceTE hasParen e = HsSpliceE (HsTypedSplice hasParen unqualSplice e)
-mkHsSpliceTy :: SpliceDecoration -> LHsExpr RdrName -> HsType RdrName
+mkHsSpliceTy :: SpliceDecoration -> LHsExpr GhcPs -> HsType GhcPs
mkHsSpliceTy hasParen e
= HsSpliceTy (HsUntypedSplice hasParen unqualSplice e) placeHolderKind
-mkHsQuasiQuote :: RdrName -> SrcSpan -> FastString -> HsSplice RdrName
+mkHsQuasiQuote :: RdrName -> SrcSpan -> FastString -> HsSplice GhcPs
mkHsQuasiQuote quoter span quote = HsQuasiQuote unqualSplice quoter span quote
unqualQuasiQuote :: RdrName
@@ -342,19 +347,19 @@ unqualQuasiQuote = mkRdrUnqual (mkVarOccFS (fsLit "quasiquote"))
-- A name (uniquified later) to
-- identify the quasi-quote
-mkHsString :: String -> HsLit
-mkHsString s = HsString NoSourceText (mkFastString s)
+mkHsString :: SourceTextX p => String -> HsLit p
+mkHsString s = HsString noSourceText (mkFastString s)
-mkHsStringPrimLit :: FastString -> HsLit
+mkHsStringPrimLit :: SourceTextX p => FastString -> HsLit p
mkHsStringPrimLit fs
- = HsStringPrim NoSourceText (fastStringToByteString fs)
+ = HsStringPrim noSourceText (fastStringToByteString fs)
-------------
-userHsLTyVarBndrs :: SrcSpan -> [Located name] -> [LHsTyVarBndr name]
+userHsLTyVarBndrs :: SrcSpan -> [Located (IdP name)] -> [LHsTyVarBndr name]
-- Caller sets location
userHsLTyVarBndrs loc bndrs = [ L loc (UserTyVar v) | v <- bndrs ]
-userHsTyVarBndrs :: SrcSpan -> [name] -> [LHsTyVarBndr name]
+userHsTyVarBndrs :: SrcSpan -> [IdP name] -> [LHsTyVarBndr name]
-- Caller sets location
userHsTyVarBndrs loc bndrs = [ L loc (UserTyVar (L loc v)) | v <- bndrs ]
@@ -367,23 +372,23 @@ userHsTyVarBndrs loc bndrs = [ L loc (UserTyVar (L loc v)) | v <- bndrs ]
************************************************************************
-}
-nlHsVar :: id -> LHsExpr id
+nlHsVar :: IdP id -> LHsExpr id
nlHsVar n = noLoc (HsVar (noLoc n))
-- NB: Only for LHsExpr **Id**
-nlHsDataCon :: DataCon -> LHsExpr Id
+nlHsDataCon :: DataCon -> LHsExpr GhcTc
nlHsDataCon con = noLoc (HsConLikeOut (RealDataCon con))
-nlHsLit :: HsLit -> LHsExpr id
+nlHsLit :: HsLit p -> LHsExpr p
nlHsLit n = noLoc (HsLit n)
-nlHsIntLit :: Integer -> LHsExpr id
-nlHsIntLit n = noLoc (HsLit (HsInt (mkIntegralLit n)))
+nlHsIntLit :: HasDefaultX p => Integer -> LHsExpr p
+nlHsIntLit n = noLoc (HsLit (HsInt def (mkIntegralLit n)))
-nlVarPat :: id -> LPat id
+nlVarPat :: IdP id -> LPat id
nlVarPat n = noLoc (VarPat (noLoc n))
-nlLitPat :: HsLit -> LPat id
+nlLitPat :: HsLit p -> LPat p
nlLitPat l = noLoc (LitPat l)
nlHsApp :: LHsExpr id -> LHsExpr id -> LHsExpr id
@@ -401,59 +406,59 @@ nlHsSyntaxApps (SyntaxExpr { syn_expr = fun
= mkLHsWrap res_wrap (foldl nlHsApp (noLoc fun) (zipWithEqual "nlHsSyntaxApps"
mkLHsWrap arg_wraps args))
-nlHsApps :: id -> [LHsExpr id] -> LHsExpr id
+nlHsApps :: IdP id -> [LHsExpr id] -> LHsExpr id
nlHsApps f xs = foldl nlHsApp (nlHsVar f) xs
-nlHsVarApps :: id -> [id] -> LHsExpr id
+nlHsVarApps :: IdP id -> [IdP id] -> LHsExpr id
nlHsVarApps f xs = noLoc (foldl mk (HsVar (noLoc f)) (map (HsVar . noLoc) xs))
where
mk f a = HsApp (noLoc f) (noLoc a)
-nlConVarPat :: RdrName -> [RdrName] -> LPat RdrName
+nlConVarPat :: RdrName -> [RdrName] -> LPat GhcPs
nlConVarPat con vars = nlConPat con (map nlVarPat vars)
-nlConVarPatName :: Name -> [Name] -> LPat Name
+nlConVarPatName :: Name -> [Name] -> LPat GhcRn
nlConVarPatName con vars = nlConPatName con (map nlVarPat vars)
-nlInfixConPat :: id -> LPat id -> LPat id -> LPat id
+nlInfixConPat :: IdP id -> LPat id -> LPat id -> LPat id
nlInfixConPat con l r = noLoc (ConPatIn (noLoc con) (InfixCon l r))
-nlConPat :: RdrName -> [LPat RdrName] -> LPat RdrName
+nlConPat :: RdrName -> [LPat GhcPs] -> LPat GhcPs
nlConPat con pats = noLoc (ConPatIn (noLoc con) (PrefixCon pats))
-nlConPatName :: Name -> [LPat Name] -> LPat Name
+nlConPatName :: Name -> [LPat GhcRn] -> LPat GhcRn
nlConPatName con pats = noLoc (ConPatIn (noLoc con) (PrefixCon pats))
-nlNullaryConPat :: id -> LPat id
+nlNullaryConPat :: IdP id -> LPat id
nlNullaryConPat con = noLoc (ConPatIn (noLoc con) (PrefixCon []))
-nlWildConPat :: DataCon -> LPat RdrName
+nlWildConPat :: DataCon -> LPat GhcPs
nlWildConPat con = noLoc (ConPatIn (noLoc (getRdrName con))
(PrefixCon (nOfThem (dataConSourceArity con)
nlWildPat)))
-nlWildPat :: LPat RdrName
+nlWildPat :: LPat GhcPs
nlWildPat = noLoc (WildPat placeHolderType ) -- Pre-typechecking
-nlWildPatName :: LPat Name
+nlWildPatName :: LPat GhcRn
nlWildPatName = noLoc (WildPat placeHolderType ) -- Pre-typechecking
-nlWildPatId :: LPat Id
+nlWildPatId :: LPat GhcTc
nlWildPatId = noLoc (WildPat placeHolderTypeTc ) -- Post-typechecking
-nlHsDo :: HsStmtContext Name -> [LStmt RdrName (LHsExpr RdrName)]
- -> LHsExpr RdrName
+nlHsDo :: HsStmtContext Name -> [LStmt GhcPs (LHsExpr GhcPs)]
+ -> LHsExpr GhcPs
nlHsDo ctxt stmts = noLoc (mkHsDo ctxt stmts)
-nlHsOpApp :: LHsExpr id -> id -> LHsExpr id -> LHsExpr id
+nlHsOpApp :: LHsExpr id -> IdP id -> LHsExpr id -> LHsExpr id
nlHsOpApp e1 op e2 = noLoc (mkHsOpApp e1 op e2)
-nlHsLam :: LMatch RdrName (LHsExpr RdrName) -> LHsExpr RdrName
+nlHsLam :: LMatch GhcPs (LHsExpr GhcPs) -> LHsExpr GhcPs
nlHsPar :: LHsExpr id -> LHsExpr id
nlHsIf :: LHsExpr id -> LHsExpr id -> LHsExpr id -> LHsExpr id
-nlHsCase :: LHsExpr RdrName -> [LMatch RdrName (LHsExpr RdrName)]
- -> LHsExpr RdrName
-nlList :: [LHsExpr RdrName] -> LHsExpr RdrName
+nlHsCase :: LHsExpr GhcPs -> [LMatch GhcPs (LHsExpr GhcPs)]
+ -> LHsExpr GhcPs
+nlList :: [LHsExpr GhcPs] -> LHsExpr GhcPs
nlHsLam match = noLoc (HsLam (mkMatchGroup Generated [match]))
nlHsPar e = noLoc (HsPar e)
@@ -467,7 +472,7 @@ nlHsCase expr matches = noLoc (HsCase expr (mkMatchGroup Generated matches))
nlList exprs = noLoc (ExplicitList placeHolderType Nothing exprs)
nlHsAppTy :: LHsType name -> LHsType name -> LHsType name
-nlHsTyVar :: name -> LHsType name
+nlHsTyVar :: IdP name -> LHsType name
nlHsFunTy :: LHsType name -> LHsType name -> LHsType name
nlHsParTy :: LHsType name -> LHsType name
@@ -476,7 +481,7 @@ nlHsTyVar x = noLoc (HsTyVar NotPromoted (noLoc x))
nlHsFunTy a b = noLoc (HsFunTy a b)
nlHsParTy t = noLoc (HsParTy t)
-nlHsTyConApp :: name -> [LHsType name] -> LHsType name
+nlHsTyConApp :: IdP name -> [LHsType name] -> LHsType name
nlHsTyConApp tycon tys = foldl nlHsAppTy (nlHsTyVar tycon) tys
{-
@@ -489,13 +494,13 @@ mkLHsTupleExpr :: [LHsExpr a] -> LHsExpr a
mkLHsTupleExpr [e] = e
mkLHsTupleExpr es = noLoc $ ExplicitTuple (map (noLoc . Present) es) Boxed
-mkLHsVarTuple :: [a] -> LHsExpr a
+mkLHsVarTuple :: [IdP a] -> LHsExpr a
mkLHsVarTuple ids = mkLHsTupleExpr (map nlHsVar ids)
nlTuplePat :: [LPat id] -> Boxity -> LPat id
nlTuplePat pats box = noLoc (TuplePat pats box [])
-missingTupArg :: HsTupArg RdrName
+missingTupArg :: HsTupArg GhcPs
missingTupArg = Missing placeHolderType
mkLHsPatTup :: [LPat id] -> LPat id
@@ -504,14 +509,14 @@ mkLHsPatTup [lpat] = lpat
mkLHsPatTup lpats = L (getLoc (head lpats)) $ TuplePat lpats Boxed []
-- The Big equivalents for the source tuple expressions
-mkBigLHsVarTup :: [id] -> LHsExpr id
+mkBigLHsVarTup :: [IdP id] -> LHsExpr id
mkBigLHsVarTup ids = mkBigLHsTup (map nlHsVar ids)
mkBigLHsTup :: [LHsExpr id] -> LHsExpr id
mkBigLHsTup = mkChunkified mkLHsTupleExpr
-- The Big equivalents for the source tuple patterns
-mkBigLHsVarPatTup :: [id] -> LPat id
+mkBigLHsVarPatTup :: [IdP id] -> LPat id
mkBigLHsVarPatTup bs = mkBigLHsPatTup (map nlVarPat bs)
mkBigLHsPatTup :: [LPat id] -> LPat id
@@ -565,14 +570,14 @@ chunkify xs
* *
********************************************************************* -}
-mkLHsSigType :: LHsType RdrName -> LHsSigType RdrName
+mkLHsSigType :: LHsType GhcPs -> LHsSigType GhcPs
mkLHsSigType ty = mkHsImplicitBndrs ty
-mkLHsSigWcType :: LHsType RdrName -> LHsSigWcType RdrName
+mkLHsSigWcType :: LHsType GhcPs -> LHsSigWcType GhcPs
mkLHsSigWcType ty = mkHsWildCardBndrs (mkHsImplicitBndrs ty)
-mkHsSigEnv :: forall a. (LSig Name -> Maybe ([Located Name], a))
- -> [LSig Name]
+mkHsSigEnv :: forall a. (LSig GhcRn -> Maybe ([Located Name], a))
+ -> [LSig GhcRn]
-> NameEnv a
mkHsSigEnv get_info sigs
= mkNameEnv (mk_pairs ordinary_sigs)
@@ -593,11 +598,11 @@ mkHsSigEnv get_info sigs
is_gen_dm_sig (L _ (ClassOpSig True _ _)) = True
is_gen_dm_sig _ = False
- mk_pairs :: [LSig Name] -> [(Name, a)]
+ mk_pairs :: [LSig GhcRn] -> [(Name, a)]
mk_pairs sigs = [ (n,a) | Just (ns,a) <- map get_info sigs
, L _ n <- ns ]
-mkClassOpSigs :: [LSig RdrName] -> [LSig RdrName]
+mkClassOpSigs :: [LSig GhcPs] -> [LSig GhcPs]
-- Convert TypeSig to ClassOpSig
-- The former is what is parsed, but the latter is
-- what we need in class/instance declarations
@@ -607,7 +612,7 @@ mkClassOpSigs sigs
fiddle (L loc (TypeSig nms ty)) = L loc (ClassOpSig False nms (dropWildCards ty))
fiddle sig = sig
-typeToLHsType :: Type -> LHsType RdrName
+typeToLHsType :: Type -> LHsType GhcPs
-- ^ Converting a Type to an HsType RdrName
-- This is needed to implement GeneralizedNewtypeDeriving.
--
@@ -616,7 +621,7 @@ typeToLHsType :: Type -> LHsType RdrName
typeToLHsType ty
= go ty
where
- go :: Type -> LHsType RdrName
+ go :: Type -> LHsType GhcPs
go ty@(FunTy arg _)
| isPredTy arg
, (theta, tau) <- tcSplitPhiTy ty
@@ -629,8 +634,8 @@ typeToLHsType ty
, hst_body = go tau })
go (TyVarTy tv) = nlHsTyVar (getRdrName tv)
go (AppTy t1 t2) = nlHsAppTy (go t1) (go t2)
- go (LitTy (NumTyLit n)) = noLoc $ HsTyLit (HsNumTy NoSourceText n)
- go (LitTy (StrTyLit s)) = noLoc $ HsTyLit (HsStrTy NoSourceText s)
+ go (LitTy (NumTyLit n)) = noLoc $ HsTyLit (HsNumTy noSourceText n)
+ go (LitTy (StrTyLit s)) = noLoc $ HsTyLit (HsStrTy noSourceText s)
go (TyConApp tc args) = nlHsTyConApp (getRdrName tc) (map go args')
where
args' = filterOutInvisibleTypes tc args
@@ -640,7 +645,7 @@ typeToLHsType ty
-- Source-language types have _invisible_ kind arguments,
-- so we must remove them here (Trac #8563)
- go_tv :: TyVar -> LHsTyVarBndr RdrName
+ go_tv :: TyVar -> LHsTyVarBndr GhcPs
go_tv tv = noLoc $ KindedTyVar (noLoc (getRdrName tv))
(go (tyVarKind tv))
@@ -687,7 +692,7 @@ mkHsWrapPatCo :: TcCoercionN -> Pat id -> Type -> Pat id
mkHsWrapPatCo co pat ty | isTcReflCo co = pat
| otherwise = CoPat (mkWpCastN co) pat ty
-mkHsDictLet :: TcEvBinds -> LHsExpr Id -> LHsExpr Id
+mkHsDictLet :: TcEvBinds -> LHsExpr GhcTc -> LHsExpr GhcTc
mkHsDictLet ev_binds expr = mkLHsWrap (mkWpLet ev_binds) expr
{-
@@ -699,8 +704,8 @@ l
************************************************************************
-}
-mkFunBind :: Located RdrName -> [LMatch RdrName (LHsExpr RdrName)]
- -> HsBind RdrName
+mkFunBind :: Located RdrName -> [LMatch GhcPs (LHsExpr GhcPs)]
+ -> HsBind GhcPs
-- Not infix, with place holders for coercion and free vars
mkFunBind fn ms = FunBind { fun_id = fn
, fun_matches = mkMatchGroup Generated ms
@@ -708,8 +713,8 @@ mkFunBind fn ms = FunBind { fun_id = fn
, bind_fvs = placeHolderNames
, fun_tick = [] }
-mkTopFunBind :: Origin -> Located Name -> [LMatch Name (LHsExpr Name)]
- -> HsBind Name
+mkTopFunBind :: Origin -> Located Name -> [LMatch GhcRn (LHsExpr GhcRn)]
+ -> HsBind GhcRn
-- In Name-land, with empty bind_fvs
mkTopFunBind origin fn ms = FunBind { fun_id = fn
, fun_matches = mkMatchGroup origin ms
@@ -718,15 +723,15 @@ mkTopFunBind origin fn ms = FunBind { fun_id = fn
-- binding
, fun_tick = [] }
-mkHsVarBind :: SrcSpan -> RdrName -> LHsExpr RdrName -> LHsBind RdrName
+mkHsVarBind :: SrcSpan -> RdrName -> LHsExpr GhcPs -> LHsBind GhcPs
mkHsVarBind loc var rhs = mk_easy_FunBind loc var [] rhs
-mkVarBind :: id -> LHsExpr id -> LHsBind id
+mkVarBind :: IdP p -> LHsExpr p -> LHsBind p
mkVarBind var rhs = L (getLoc rhs) $
VarBind { var_id = var, var_rhs = rhs, var_inline = False }
mkPatSynBind :: Located RdrName -> HsPatSynDetails (Located RdrName)
- -> LPat RdrName -> HsPatSynDir RdrName -> HsBind RdrName
+ -> LPat GhcPs -> HsPatSynDir GhcPs -> HsBind GhcPs
mkPatSynBind name details lpat dir = PatSynBind psb
where
psb = PSB{ psb_id = name
@@ -744,8 +749,8 @@ isInfixFunBind _ = False
------------
-mk_easy_FunBind :: SrcSpan -> RdrName -> [LPat RdrName]
- -> LHsExpr RdrName -> LHsBind RdrName
+mk_easy_FunBind :: SrcSpan -> RdrName -> [LPat GhcPs]
+ -> LHsExpr GhcPs -> LHsBind GhcPs
mk_easy_FunBind loc fun pats expr
= L loc $ mkFunBind (L loc fun)
[mkMatch (mkPrefixFunRhs (L loc fun)) pats expr
@@ -756,8 +761,8 @@ mkPrefixFunRhs :: Located id -> HsMatchContext id
mkPrefixFunRhs n = FunRhs n Prefix
------------
-mkMatch :: HsMatchContext (NameOrRdrName id) -> [LPat id] -> LHsExpr id
- -> Located (HsLocalBinds id) -> LMatch id (LHsExpr id)
+mkMatch :: HsMatchContext (NameOrRdrName (IdP p)) -> [LPat p] -> LHsExpr p
+ -> Located (HsLocalBinds p) -> LMatch p (LHsExpr p)
mkMatch ctxt pats expr lbinds
= noLoc (Match ctxt (map paren pats) Nothing
(GRHSs (unguardedRHS noSrcSpan expr) lbinds))
@@ -840,7 +845,7 @@ is a lifted function type, with no trouble at all.
-- bind that binds an unlifted variable, but we must be careful around
-- AbsBinds. See Note [Unlifted id check in isUnliftedHsBind]. For usage
-- information, see Note [Strict binds check] is DsBinds.
-isUnliftedHsBind :: HsBind Id -> Bool -- works only over typechecked binds
+isUnliftedHsBind :: HsBind GhcTc -> Bool -- works only over typechecked binds
isUnliftedHsBind (AbsBindsSig { abs_sig_export = id })
= isUnliftedType (idType id)
isUnliftedHsBind bind
@@ -854,40 +859,40 @@ isUnliftedHsBind bind
-- would get type forall a. Num a => (# a, Bool #)
-- and we want to reject that. See Trac #9140
-collectLocalBinders :: HsLocalBindsLR idL idR -> [idL]
+collectLocalBinders :: HsLocalBindsLR idL idR -> [IdP idL]
collectLocalBinders (HsValBinds binds) = collectHsIdBinders binds
-- No pattern synonyms here
collectLocalBinders (HsIPBinds _) = []
collectLocalBinders EmptyLocalBinds = []
-collectHsIdBinders, collectHsValBinders :: HsValBindsLR idL idR -> [idL]
+collectHsIdBinders, collectHsValBinders :: HsValBindsLR idL idR -> [IdP idL]
-- Collect Id binders only, or Ids + pattern synonyms, respectively
collectHsIdBinders = collect_hs_val_binders True
collectHsValBinders = collect_hs_val_binders False
-collectHsBindBinders :: HsBindLR idL idR -> [idL]
+collectHsBindBinders :: HsBindLR idL idR -> [IdP idL]
-- Collect both Ids and pattern-synonym binders
collectHsBindBinders b = collect_bind False b []
-collectHsBindsBinders :: LHsBindsLR idL idR -> [idL]
+collectHsBindsBinders :: LHsBindsLR idL idR -> [IdP idL]
collectHsBindsBinders binds = collect_binds False binds []
-collectHsBindListBinders :: [LHsBindLR idL idR] -> [idL]
+collectHsBindListBinders :: [LHsBindLR idL idR] -> [IdP idL]
-- Same as collectHsBindsBinders, but works over a list of bindings
collectHsBindListBinders = foldr (collect_bind False . unLoc) []
-collect_hs_val_binders :: Bool -> HsValBindsLR idL idR -> [idL]
+collect_hs_val_binders :: Bool -> HsValBindsLR idL idR -> [IdP idL]
collect_hs_val_binders ps (ValBindsIn binds _) = collect_binds ps binds []
collect_hs_val_binders ps (ValBindsOut binds _) = collect_out_binds ps binds
-collect_out_binds :: Bool -> [(RecFlag, LHsBinds id)] -> [id]
+collect_out_binds :: Bool -> [(RecFlag, LHsBinds p)] -> [IdP p]
collect_out_binds ps = foldr (collect_binds ps . snd) []
-collect_binds :: Bool -> LHsBindsLR idL idR -> [idL] -> [idL]
+collect_binds :: Bool -> LHsBindsLR idL idR -> [IdP idL] -> [IdP idL]
-- Collect Ids, or Ids + pattern synonyms, depending on boolean flag
collect_binds ps binds acc = foldrBag (collect_bind ps . unLoc) acc binds
-collect_bind :: Bool -> HsBindLR idL idR -> [idL] -> [idL]
+collect_bind :: Bool -> HsBindLR idL idR -> [IdP idL] -> [IdP idL]
collect_bind _ (PatBind { pat_lhs = p }) acc = collect_lpat p acc
collect_bind _ (FunBind { fun_id = L _ f }) acc = f : acc
collect_bind _ (VarBind { var_id = f }) acc = f : acc
@@ -900,7 +905,7 @@ collect_bind omitPatSyn (PatSynBind (PSB { psb_id = L _ ps })) acc
| omitPatSyn = acc
| otherwise = ps : acc
-collectMethodBinders :: LHsBindsLR RdrName idR -> [Located RdrName]
+collectMethodBinders :: LHsBindsLR GhcPs idR -> [Located RdrName]
-- Used exclusively for the bindings of an instance decl which are all FunBinds
collectMethodBinders binds = foldrBag (get . unLoc) [] binds
where
@@ -909,16 +914,16 @@ collectMethodBinders binds = foldrBag (get . unLoc) [] binds
-- Someone else complains about non-FunBinds
----------------- Statements --------------------------
-collectLStmtsBinders :: [LStmtLR idL idR body] -> [idL]
+collectLStmtsBinders :: [LStmtLR idL idR body] -> [IdP idL]
collectLStmtsBinders = concatMap collectLStmtBinders
-collectStmtsBinders :: [StmtLR idL idR body] -> [idL]
+collectStmtsBinders :: [StmtLR idL idR body] -> [IdP idL]
collectStmtsBinders = concatMap collectStmtBinders
-collectLStmtBinders :: LStmtLR idL idR body -> [idL]
+collectLStmtBinders :: LStmtLR idL idR body -> [IdP idL]
collectLStmtBinders = collectStmtBinders . unLoc
-collectStmtBinders :: StmtLR idL idR body -> [idL]
+collectStmtBinders :: StmtLR idL idR body -> [IdP idL]
-- Id Binders for a Stmt... [but what about pattern-sig type vars]?
collectStmtBinders (BindStmt pat _ _ _ _)= collectPatBinders pat
collectStmtBinders (LetStmt (L _ binds)) = collectLocalBinders binds
@@ -932,14 +937,14 @@ collectStmtBinders ApplicativeStmt{} = []
----------------- Patterns --------------------------
-collectPatBinders :: LPat a -> [a]
+collectPatBinders :: LPat a -> [IdP a]
collectPatBinders pat = collect_lpat pat []
-collectPatsBinders :: [LPat a] -> [a]
+collectPatsBinders :: [LPat a] -> [IdP a]
collectPatsBinders pats = foldr collect_lpat [] pats
-------------
-collect_lpat :: LPat name -> [name] -> [name]
+collect_lpat :: LPat pass -> [IdP pass] -> [IdP pass]
collect_lpat (L _ pat) bndrs
= go pat
where
@@ -999,14 +1004,14 @@ variables bound by the lazy pattern are n,m, *not* the dictionary d.
So in mkSelectorBinds in DsUtils, we want just m,n as the variables bound.
-}
-hsGroupBinders :: HsGroup Name -> [Name]
+hsGroupBinders :: HsGroup GhcRn -> [Name]
hsGroupBinders (HsGroup { hs_valds = val_decls, hs_tyclds = tycl_decls,
hs_fords = foreign_decls })
= collectHsValBinders val_decls
++ hsTyClForeignBinders tycl_decls foreign_decls
-hsTyClForeignBinders :: [TyClGroup Name]
- -> [LForeignDecl Name]
+hsTyClForeignBinders :: [TyClGroup GhcRn]
+ -> [LForeignDecl GhcRn]
-> [Name]
-- We need to look at instance declarations too,
-- because their associated types may bind data constructors
@@ -1017,13 +1022,13 @@ hsTyClForeignBinders tycl_decls foreign_decls
`mappend`
foldMap (foldMap hsLInstDeclBinders . group_instds) tycl_decls)
where
- getSelectorNames :: ([Located Name], [LFieldOcc Name]) -> [Name]
+ getSelectorNames :: ([Located Name], [LFieldOcc GhcRn]) -> [Name]
getSelectorNames (ns, fs) = map unLoc ns ++ map (selectorFieldOcc.unLoc) fs
-------------------
-hsLTyClDeclBinders :: Located (TyClDecl name) -> ([Located name], [LFieldOcc name])
+hsLTyClDeclBinders :: Located (TyClDecl pass)
+ -> ([Located (IdP pass)], [LFieldOcc pass])
-- ^ Returns all the /binding/ names of the decl. The first one is
-
-- guaranteed to be the name of the decl. The first component
-- represents all binding names except record fields; the second
-- represents field occurrences. For record fields mentioned in
@@ -1045,7 +1050,7 @@ hsLTyClDeclBinders (L loc (DataDecl { tcdLName = L _ name, tcdDataDefn = defn
= (\ (xs, ys) -> (L loc name : xs, ys)) $ hsDataDefnBinders defn
-------------------
-hsForeignDeclsBinders :: [LForeignDecl name] -> [Located name]
+hsForeignDeclsBinders :: [LForeignDecl pass] -> [Located (IdP pass)]
-- See Note [SrcSpan for binders]
hsForeignDeclsBinders foreign_decls
= [ L decl_loc n
@@ -1053,14 +1058,14 @@ hsForeignDeclsBinders foreign_decls
-------------------
-hsPatSynSelectors :: HsValBinds id -> [id]
+hsPatSynSelectors :: HsValBinds p -> [IdP p]
-- Collects record pattern-synonym selectors only; the pattern synonym
-- names are collected by collectHsValBinders.
hsPatSynSelectors (ValBindsIn _ _) = panic "hsPatSynSelectors"
hsPatSynSelectors (ValBindsOut binds _)
= foldrBag addPatSynSelector [] . unionManyBags $ map snd binds
-addPatSynSelector:: LHsBind id -> [id] -> [id]
+addPatSynSelector:: LHsBind p -> [IdP p] -> [IdP p]
addPatSynSelector bind sels
| L _ (PatSynBind (PSB { psb_args = RecordPatSyn as })) <- bind
= map (unLoc . recordPatSynSelectorId) as ++ sels
@@ -1072,7 +1077,8 @@ getPatSynBinds binds
, L _ (PatSynBind psb) <- bagToList lbinds ]
-------------------
-hsLInstDeclBinders :: LInstDecl name -> ([Located name], [LFieldOcc name])
+hsLInstDeclBinders :: LInstDecl pass
+ -> ([Located (IdP pass)], [LFieldOcc pass])
hsLInstDeclBinders (L _ (ClsInstD { cid_inst = ClsInstDecl { cid_datafam_insts = dfis } }))
= foldMap (hsDataFamInstBinders . unLoc) dfis
hsLInstDeclBinders (L _ (DataFamInstD { dfid_inst = fi }))
@@ -1081,26 +1087,27 @@ hsLInstDeclBinders (L _ (TyFamInstD {})) = mempty
-------------------
-- the SrcLoc returned are for the whole declarations, not just the names
-hsDataFamInstBinders :: DataFamInstDecl name -> ([Located name], [LFieldOcc name])
+hsDataFamInstBinders :: DataFamInstDecl pass
+ -> ([Located (IdP pass)], [LFieldOcc pass])
hsDataFamInstBinders (DataFamInstDecl { dfid_defn = defn })
= hsDataDefnBinders defn
-- There can't be repeated symbols because only data instances have binders
-------------------
-- the SrcLoc returned are for the whole declarations, not just the names
-hsDataDefnBinders :: HsDataDefn name -> ([Located name], [LFieldOcc name])
+hsDataDefnBinders :: HsDataDefn pass -> ([Located (IdP pass)], [LFieldOcc pass])
hsDataDefnBinders (HsDataDefn { dd_cons = cons })
= hsConDeclsBinders cons
-- See Note [Binders in family instances]
-------------------
-hsConDeclsBinders :: [LConDecl name] -> ([Located name], [LFieldOcc name])
+hsConDeclsBinders :: [LConDecl pass] -> ([Located (IdP pass)], [LFieldOcc pass])
-- See hsLTyClDeclBinders for what this does
-- The function is boringly complicated because of the records
-- And since we only have equality, we have to be a little careful
hsConDeclsBinders cons = go id cons
- where go :: ([LFieldOcc name] -> [LFieldOcc name])
- -> [LConDecl name] -> ([Located name], [LFieldOcc name])
+ where go :: ([LFieldOcc pass] -> [LFieldOcc pass])
+ -> [LConDecl pass] -> ([Located (IdP pass)], [LFieldOcc pass])
go _ [] = ([], [])
go remSeen (r:rs) =
-- don't re-mangle the location of field names, because we don't
@@ -1176,13 +1183,13 @@ The main purpose is to find names introduced by record wildcards so that we can
warning the user when they don't use those names (#4404)
-}
-lStmtsImplicits :: [LStmtLR Name idR (Located (body idR))] -> NameSet
+lStmtsImplicits :: [LStmtLR GhcRn idR (Located (body idR))] -> NameSet
lStmtsImplicits = hs_lstmts
where
- hs_lstmts :: [LStmtLR Name idR (Located (body idR))] -> NameSet
+ hs_lstmts :: [LStmtLR GhcRn idR (Located (body idR))] -> NameSet
hs_lstmts = foldr (\stmt rest -> unionNameSet (hs_stmt (unLoc stmt)) rest) emptyNameSet
- hs_stmt :: StmtLR Name idR (Located (body idR)) -> NameSet
+ hs_stmt :: StmtLR GhcRn idR (Located (body idR)) -> NameSet
hs_stmt (BindStmt pat _ _ _ _) = lPatImplicits pat
hs_stmt (ApplicativeStmt args _ _) = unionNameSets (map do_arg args)
where do_arg (_, ApplicativeArgOne pat _) = lPatImplicits pat
@@ -1198,19 +1205,19 @@ lStmtsImplicits = hs_lstmts
hs_local_binds (HsIPBinds _) = emptyNameSet
hs_local_binds EmptyLocalBinds = emptyNameSet
-hsValBindsImplicits :: HsValBindsLR Name idR -> NameSet
+hsValBindsImplicits :: HsValBindsLR GhcRn idR -> NameSet
hsValBindsImplicits (ValBindsOut binds _)
= foldr (unionNameSet . lhsBindsImplicits . snd) emptyNameSet binds
hsValBindsImplicits (ValBindsIn binds _)
= lhsBindsImplicits binds
-lhsBindsImplicits :: LHsBindsLR Name idR -> NameSet
+lhsBindsImplicits :: LHsBindsLR GhcRn idR -> NameSet
lhsBindsImplicits = foldBag unionNameSet (lhs_bind . unLoc) emptyNameSet
where
lhs_bind (PatBind { pat_lhs = lpat }) = lPatImplicits lpat
lhs_bind _ = emptyNameSet
-lPatImplicits :: LPat Name -> NameSet
+lPatImplicits :: LPat GhcRn -> NameSet
lPatImplicits = hs_lpat
where
hs_lpat (L _ pat) = hs_pat pat
diff --git a/compiler/hsSyn/PlaceHolder.hs b/compiler/hsSyn/PlaceHolder.hs
index 2e195df799..5c716d259c 100644
--- a/compiler/hsSyn/PlaceHolder.hs
+++ b/compiler/hsSyn/PlaceHolder.hs
@@ -12,14 +12,8 @@ import Name
import NameSet
import RdrName
import Var
-import Coercion
-import ConLike (ConLike)
-import FieldLabel
-import SrcLoc (Located)
-import TcEvidence ( HsWrapper )
import Data.Data hiding ( Fixity )
-import BasicTypes (Fixity)
{-
@@ -37,18 +31,6 @@ import BasicTypes (Fixity)
data PlaceHolder = PlaceHolder
deriving (Data)
--- | Types that are not defined until after type checking
-type family PostTc id ty -- Note [Pass sensitive types]
-type instance PostTc Id ty = ty
-type instance PostTc Name ty = PlaceHolder
-type instance PostTc RdrName ty = PlaceHolder
-
--- | Types that are not defined until after renaming
-type family PostRn id ty -- Note [Pass sensitive types]
-type instance PostRn Id ty = ty
-type instance PostRn Name ty = ty
-type instance PostRn RdrName ty = PlaceHolder
-
placeHolderKind :: PlaceHolder
placeHolderKind = PlaceHolder
@@ -103,31 +85,6 @@ DataId constraint type based on this, so even though it is safe the
UndecidableInstances pragma is required where this is used.
-}
-type DataId id =
- ( DataIdPost id
- , DataIdPost (NameOrRdrName id)
- )
-
-type DataIdPost id =
- ( Data id
- , Data (PostRn id NameSet)
- , Data (PostRn id Fixity)
- , Data (PostRn id Bool)
- , Data (PostRn id Name)
- , Data (PostRn id (Located Name))
- , Data (PostRn id [Name])
-
- , Data (PostRn id id)
- , Data (PostTc id Type)
- , Data (PostTc id Coercion)
- , Data (PostTc id id)
- , Data (PostTc id [Type])
- , Data (PostTc id ConLike)
- , Data (PostTc id [ConLike])
- , Data (PostTc id HsWrapper)
- , Data (PostTc id [FieldLabel])
- )
-
-- |Follow the @id@, but never beyond Name. This is used in a 'HsMatchContext',
-- for printing messages related to a 'Match'
@@ -135,10 +92,3 @@ type family NameOrRdrName id where
NameOrRdrName Id = Name
NameOrRdrName Name = Name
NameOrRdrName RdrName = RdrName
-
--- |Constraint type to bundle up the requirement for 'OutputableBndr' on both
--- the @id@ and the 'NameOrRdrName' type for it
-type OutputableBndrId id =
- ( OutputableBndr id
- , OutputableBndr (NameOrRdrName id)
- )
View Lorry Controller Status