Commit 5819ae21 authored by Alan Zimmerman's avatar Alan Zimmerman
Browse files

Remove HasSourceText and SourceTextX classes

Updates haddock submodule to match.

Test Plan : Validate

Differential Revision: https://phabricator.haskell.org/D4199
parent 718a0181
......@@ -754,8 +754,8 @@ addTick isGuard e | Just fn <- isGuard = addBinTickLHsExpr fn e
| otherwise = addTickLHsExprRHS e
addTickApplicativeArg
:: Maybe (Bool -> BoxLabel) -> (SyntaxExpr GhcTc, ApplicativeArg GhcTc GhcTc)
-> TM (SyntaxExpr GhcTc, ApplicativeArg GhcTc GhcTc)
:: Maybe (Bool -> BoxLabel) -> (SyntaxExpr GhcTc, ApplicativeArg GhcTc)
-> TM (SyntaxExpr GhcTc, ApplicativeArg GhcTc)
addTickApplicativeArg isGuard (op, arg) =
liftM2 (,) (addTickSyntaxExpr hpcSrcSpan op) (addTickArg arg)
where
......
......@@ -2390,16 +2390,16 @@ repLiteral lit
mk_integer :: Integer -> DsM (HsLit GhcRn)
mk_integer i = do integer_ty <- lookupType integerTyConName
return $ HsInteger noSourceText i integer_ty
return $ HsInteger NoSourceText i integer_ty
mk_rational :: FractionalLit -> DsM (HsLit GhcRn)
mk_rational r = do rat_ty <- lookupType rationalTyConName
return $ HsRat def r rat_ty
mk_string :: FastString -> DsM (HsLit GhcRn)
mk_string s = return $ HsString noSourceText s
mk_string s = return $ HsString NoSourceText s
mk_char :: Char -> DsM (HsLit GhcRn)
mk_char c = return $ HsChar noSourceText c
mk_char c = return $ HsChar NoSourceText c
repOverloadedLiteral :: HsOverLit GhcRn -> DsM (Core TH.Lit)
repOverloadedLiteral (OverLit { ol_val = val})
......
......@@ -14,6 +14,7 @@ Datatype for: @BindGroup@, @Bind@, @Sig@, @Bind@.
-- in module PlaceHolder
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE TypeFamilies #-}
module HsBinds where
......@@ -560,14 +561,14 @@ Specifically,
it's just an error thunk
-}
instance (SourceTextX idL, SourceTextX idR,
instance (idL ~ GhcPass pl, idR ~ GhcPass pr,
OutputableBndrId idL, OutputableBndrId idR)
=> Outputable (HsLocalBindsLR idL idR) where
ppr (HsValBinds bs) = ppr bs
ppr (HsIPBinds bs) = ppr bs
ppr EmptyLocalBinds = empty
instance (SourceTextX idL, SourceTextX idR,
instance (idL ~ GhcPass pl, idR ~ GhcPass pr,
OutputableBndrId idL, OutputableBndrId idR)
=> Outputable (HsValBindsLR idL idR) where
ppr (ValBindsIn binds sigs)
......@@ -584,17 +585,16 @@ instance (SourceTextX idL, SourceTextX idR,
pp_rec Recursive = text "rec"
pp_rec NonRecursive = text "nonrec"
pprLHsBinds :: (SourceTextX idL, SourceTextX idR,
OutputableBndrId idL, OutputableBndrId idR)
=> LHsBindsLR idL idR -> SDoc
pprLHsBinds :: (OutputableBndrId (GhcPass idL), OutputableBndrId (GhcPass idR))
=> LHsBindsLR (GhcPass idL) (GhcPass idR) -> SDoc
pprLHsBinds binds
| isEmptyLHsBinds binds = empty
| otherwise = pprDeclList (map ppr (bagToList binds))
pprLHsBindsForUser :: (SourceTextX idL, SourceTextX idR,
OutputableBndrId idL, OutputableBndrId idR,
SourceTextX id2, OutputableBndrId id2)
=> LHsBindsLR idL idR -> [LSig id2] -> [SDoc]
pprLHsBindsForUser :: (OutputableBndrId (GhcPass idL),
OutputableBndrId (GhcPass idR),
OutputableBndrId (GhcPass id2))
=> LHsBindsLR (GhcPass idL) (GhcPass idR) -> [LSig (GhcPass id2)] -> [SDoc]
-- pprLHsBindsForUser is different to pprLHsBinds because
-- a) No braces: 'let' and 'where' include a list of HsBindGroups
-- and we don't want several groups of bindings each
......@@ -658,14 +658,13 @@ plusHsValBinds (ValBindsOut ds1 sigs1) (ValBindsOut ds2 sigs2)
plusHsValBinds _ _
= panic "HsBinds.plusHsValBinds"
instance (SourceTextX idL, SourceTextX idR,
instance (idL ~ GhcPass pl, idR ~ GhcPass pr,
OutputableBndrId idL, OutputableBndrId idR)
=> Outputable (HsBindLR idL idR) where
ppr mbind = ppr_monobind mbind
ppr_monobind :: (SourceTextX idL, SourceTextX idR,
OutputableBndrId idL, OutputableBndrId idR)
=> HsBindLR idL idR -> SDoc
ppr_monobind :: (OutputableBndrId (GhcPass idL), OutputableBndrId (GhcPass idR))
=> HsBindLR (GhcPass idL) (GhcPass idR) -> SDoc
ppr_monobind (PatBind { pat_lhs = pat, pat_rhs = grhss })
= pprPatBind pat grhss
......@@ -705,8 +704,7 @@ instance (OutputableBndrId p) => Outputable (ABExport p) where
, nest 2 (pprTcSpecPrags prags)
, nest 2 (text "wrap:" <+> ppr wrap)]
instance (SourceTextX idR,
OutputableBndrId idL, OutputableBndrId idR)
instance (idR ~ GhcPass pr,OutputableBndrId idL, OutputableBndrId idR)
=> Outputable (PatSynBind idL idR) where
ppr (PSB{ psb_id = (L _ psyn), psb_args = details, psb_def = pat,
psb_dir = dir })
......@@ -777,11 +775,12 @@ data IPBind id
= IPBind (Either (Located HsIPName) (IdP id)) (LHsExpr id)
deriving instance (DataId name) => Data (IPBind name)
instance (SourceTextX p, OutputableBndrId p) => Outputable (HsIPBinds p) where
instance (p ~ GhcPass pass, OutputableBndrId p)
=> Outputable (HsIPBinds p) where
ppr (IPBinds bs ds) = pprDeeperList vcat (map ppr bs)
$$ whenPprDebug (ppr ds)
instance (SourceTextX p, OutputableBndrId p ) => Outputable (IPBind p) where
instance (p ~ GhcPass pass, 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
......@@ -1054,11 +1053,10 @@ 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 (SourceTextX pass, OutputableBndrId pass)
=> Outputable (Sig pass) where
instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (Sig p) where
ppr sig = ppr_sig sig
ppr_sig :: (SourceTextX pass, OutputableBndrId pass ) => Sig pass -> SDoc
ppr_sig :: (OutputableBndrId (GhcPass p)) => Sig (GhcPass p) -> 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)
......
......@@ -10,7 +10,7 @@
{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
-- in module PlaceHolder
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
-- | Abstract syntax of global declarations.
--
......@@ -253,8 +253,7 @@ appendGroups
hs_vects = vects1 ++ vects2,
hs_docs = docs1 ++ docs2 }
instance (SourceTextX pass, OutputableBndrId pass)
=> Outputable (HsDecl pass) where
instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsDecl p) where
ppr (TyClD dcl) = ppr dcl
ppr (ValD binds) = ppr binds
ppr (DefD def) = ppr def
......@@ -270,8 +269,7 @@ instance (SourceTextX pass, OutputableBndrId pass)
ppr (DocD doc) = ppr doc
ppr (RoleAnnotD ra) = ppr ra
instance (SourceTextX pass, OutputableBndrId pass)
=> Outputable (HsGroup pass) where
instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsGroup p) where
ppr (HsGroup { hs_valds = val_decls,
hs_tyclds = tycl_decls,
hs_derivds = deriv_decls,
......@@ -315,8 +313,8 @@ data SpliceDecl id
SpliceExplicitFlag
deriving instance (DataId id) => Data (SpliceDecl id)
instance (SourceTextX pass, OutputableBndrId pass)
=> Outputable (SpliceDecl pass) where
instance (p ~ GhcPass pass, OutputableBndrId p)
=> Outputable (SpliceDecl p) where
ppr (SpliceDecl (L _ e) f) = pprSpliceDecl e f
{-
......@@ -640,8 +638,7 @@ hsDeclHasCusk (ClassDecl { tcdTyVars = tyvars }) = hsTvbAllKinded tyvars
-- Pretty-printing TyClDecl
-- ~~~~~~~~~~~~~~~~~~~~~~~~
instance (SourceTextX pass, OutputableBndrId pass)
=> Outputable (TyClDecl pass) where
instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (TyClDecl p) where
ppr (FamDecl { tcdFam = decl }) = ppr decl
ppr (SynDecl { tcdLName = ltycon, tcdTyVars = tyvars, tcdFixity = fixity
......@@ -672,8 +669,8 @@ instance (SourceTextX pass, OutputableBndrId pass)
<+> pp_vanilla_decl_head lclas tyvars fixity (unLoc context)
<+> pprFundeps (map unLoc fds)
instance (SourceTextX pass, OutputableBndrId pass)
=> Outputable (TyClGroup pass) where
instance (p ~ GhcPass pass, OutputableBndrId p)
=> Outputable (TyClGroup p) where
ppr (TyClGroup { group_tyclds = tyclds
, group_roles = roles
, group_instds = instds
......@@ -683,11 +680,11 @@ instance (SourceTextX pass, OutputableBndrId pass)
ppr roles $$
ppr instds
pp_vanilla_decl_head :: (SourceTextX pass, OutputableBndrId pass)
=> Located (IdP pass)
-> LHsQTyVars pass
pp_vanilla_decl_head :: (OutputableBndrId (GhcPass p))
=> Located (IdP (GhcPass p))
-> LHsQTyVars (GhcPass p)
-> LexicalFixity
-> HsContext pass
-> HsContext (GhcPass p)
-> SDoc
pp_vanilla_decl_head thing (HsQTvs { hsq_explicit = tyvars }) fixity context
= hsep [pprHsContext context, pp_tyvars tyvars]
......@@ -971,12 +968,12 @@ resultVariableName :: FamilyResultSig a -> Maybe (IdP a)
resultVariableName (TyVarSig sig) = Just $ hsLTyVarName sig
resultVariableName _ = Nothing
instance (SourceTextX pass, OutputableBndrId pass)
=> Outputable (FamilyDecl pass) where
instance (p ~ GhcPass pass, OutputableBndrId p)
=> Outputable (FamilyDecl p) where
ppr = pprFamilyDecl TopLevel
pprFamilyDecl :: (SourceTextX pass, OutputableBndrId pass)
=> TopLevelFlag -> FamilyDecl pass -> SDoc
pprFamilyDecl :: (OutputableBndrId (GhcPass p))
=> TopLevelFlag -> FamilyDecl (GhcPass p) -> SDoc
pprFamilyDecl top_level (FamilyDecl { fdInfo = info, fdLName = ltycon
, fdTyVars = tyvars
, fdFixity = fixity
......@@ -1093,8 +1090,8 @@ data HsDerivingClause pass
}
deriving instance (DataId id) => Data (HsDerivingClause id)
instance (SourceTextX pass, OutputableBndrId pass)
=> Outputable (HsDerivingClause pass) where
instance (p ~ GhcPass pass, OutputableBndrId p)
=> Outputable (HsDerivingClause p) where
ppr (HsDerivingClause { deriv_clause_strategy = dcs
, deriv_clause_tys = L _ dct })
= hsep [ text "deriving"
......@@ -1244,9 +1241,9 @@ hsConDeclTheta :: Maybe (LHsContext pass) -> [LHsType pass]
hsConDeclTheta Nothing = []
hsConDeclTheta (Just (L _ theta)) = theta
pp_data_defn :: (SourceTextX p, OutputableBndrId p)
=> (HsContext p -> SDoc) -- Printing the header
-> HsDataDefn p
pp_data_defn :: (OutputableBndrId (GhcPass p))
=> (HsContext (GhcPass p) -> SDoc) -- Printing the header
-> HsDataDefn (GhcPass p)
-> SDoc
pp_data_defn pp_hdr (HsDataDefn { dd_ND = new_or_data, dd_ctxt = L _ context
, dd_cType = mb_ct
......@@ -1268,26 +1265,24 @@ 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 (SourceTextX pass, OutputableBndrId pass)
=> Outputable (HsDataDefn pass) where
instance (p ~ GhcPass pass, OutputableBndrId p)
=> Outputable (HsDataDefn p) where
ppr d = pp_data_defn (\_ -> text "Naked HsDataDefn") d
instance Outputable NewOrData where
ppr NewType = text "newtype"
ppr DataType = text "data"
pp_condecls :: (SourceTextX pass, OutputableBndrId pass)
=> [LConDecl pass] -> SDoc
pp_condecls :: (OutputableBndrId (GhcPass p)) => [LConDecl (GhcPass p)] -> 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 (SourceTextX pass, OutputableBndrId pass)
=> Outputable (ConDecl pass) where
instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (ConDecl p) where
ppr = pprConDecl
pprConDecl :: (SourceTextX pass, OutputableBndrId pass) => ConDecl pass -> SDoc
pprConDecl :: (OutputableBndrId (GhcPass p)) => ConDecl (GhcPass p) -> SDoc
pprConDecl (ConDeclH98 { con_name = L _ con
, con_ex_tvs = ex_tvs
, con_mb_cxt = mcxt
......@@ -1516,12 +1511,12 @@ data InstDecl pass -- Both class and family instances
{ tfid_inst :: TyFamInstDecl pass }
deriving instance (DataId id) => Data (InstDecl id)
instance (SourceTextX pass, OutputableBndrId pass)
=> Outputable (TyFamInstDecl pass) where
instance (p ~ GhcPass pass, OutputableBndrId p)
=> Outputable (TyFamInstDecl p) where
ppr = pprTyFamInstDecl TopLevel
pprTyFamInstDecl :: (SourceTextX pass, OutputableBndrId pass)
=> TopLevelFlag -> TyFamInstDecl pass -> SDoc
pprTyFamInstDecl :: (OutputableBndrId (GhcPass p))
=> TopLevelFlag -> TyFamInstDecl (GhcPass p) -> SDoc
pprTyFamInstDecl top_lvl (TyFamInstDecl { tfid_eqn = eqn })
= text "type" <+> ppr_instance_keyword top_lvl <+> ppr_fam_inst_eqn eqn
......@@ -1529,16 +1524,16 @@ ppr_instance_keyword :: TopLevelFlag -> SDoc
ppr_instance_keyword TopLevel = text "instance"
ppr_instance_keyword NotTopLevel = empty
ppr_fam_inst_eqn :: (SourceTextX pass, OutputableBndrId pass)
=> TyFamInstEqn pass -> SDoc
ppr_fam_inst_eqn :: (OutputableBndrId (GhcPass p))
=> TyFamInstEqn (GhcPass p) -> SDoc
ppr_fam_inst_eqn (HsIB { hsib_body = FamEqn { feqn_tycon = tycon
, feqn_pats = pats
, feqn_fixity = fixity
, feqn_rhs = rhs }})
= pprFamInstLHS tycon pats fixity [] Nothing <+> equals <+> ppr rhs
ppr_fam_deflt_eqn :: (SourceTextX pass, OutputableBndrId pass)
=> LTyFamDefltEqn pass -> SDoc
ppr_fam_deflt_eqn :: (OutputableBndrId (GhcPass p))
=> LTyFamDefltEqn (GhcPass p) -> SDoc
ppr_fam_deflt_eqn (L _ (FamEqn { feqn_tycon = tycon
, feqn_pats = tvs
, feqn_fixity = fixity
......@@ -1546,12 +1541,12 @@ ppr_fam_deflt_eqn (L _ (FamEqn { feqn_tycon = tycon
= text "type" <+> pp_vanilla_decl_head tycon tvs fixity []
<+> equals <+> ppr rhs
instance (SourceTextX pass, OutputableBndrId pass)
=> Outputable (DataFamInstDecl pass) where
instance (p ~ GhcPass pass, OutputableBndrId p)
=> Outputable (DataFamInstDecl p) where
ppr = pprDataFamInstDecl TopLevel
pprDataFamInstDecl :: (SourceTextX pass, OutputableBndrId pass)
=> TopLevelFlag -> DataFamInstDecl pass -> SDoc
pprDataFamInstDecl :: (OutputableBndrId (GhcPass p))
=> TopLevelFlag -> DataFamInstDecl (GhcPass p) -> SDoc
pprDataFamInstDecl top_lvl (DataFamInstDecl { dfid_eqn = HsIB { hsib_body =
FamEqn { feqn_tycon = tycon
, feqn_pats = pats
......@@ -1570,12 +1565,12 @@ pprDataFamInstFlavour (DataFamInstDecl { dfid_eqn = HsIB { hsib_body =
FamEqn { feqn_rhs = HsDataDefn { dd_ND = nd }}}})
= ppr nd
pprFamInstLHS :: (SourceTextX pass, OutputableBndrId pass)
=> Located (IdP pass)
-> HsTyPats pass
pprFamInstLHS :: (OutputableBndrId (GhcPass p))
=> Located (IdP (GhcPass p))
-> HsTyPats (GhcPass p)
-> LexicalFixity
-> HsContext pass
-> Maybe (LHsKind pass)
-> HsContext (GhcPass p)
-> Maybe (LHsKind (GhcPass p))
-> SDoc
pprFamInstLHS thing typats fixity context mb_kind_sig
-- explicit type patterns
......@@ -1595,8 +1590,8 @@ pprFamInstLHS thing typats fixity context mb_kind_sig
| otherwise
= empty
instance (SourceTextX pass, OutputableBndrId pass)
=> Outputable (ClsInstDecl pass) where
instance (p ~ GhcPass pass, OutputableBndrId p)
=> Outputable (ClsInstDecl p) where
ppr (ClsInstDecl { cid_poly_ty = inst_ty, cid_binds = binds
, cid_sigs = sigs, cid_tyfam_insts = ats
, cid_overlap_mode = mbOverlap
......@@ -1634,8 +1629,7 @@ ppOverlapPragma mb =
maybe_stext (SourceText src) _ = text src <+> text "#-}"
instance (SourceTextX pass, OutputableBndrId pass)
=> Outputable (InstDecl pass) where
instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (InstDecl p) where
ppr (ClsInstD { cid_inst = decl }) = ppr decl
ppr (TyFamInstD { tfid_inst = decl }) = ppr decl
ppr (DataFamInstD { dfid_inst = decl }) = ppr decl
......@@ -1687,8 +1681,8 @@ data DerivDecl pass = DerivDecl
}
deriving instance (DataId pass) => Data (DerivDecl pass)
instance (SourceTextX pass, OutputableBndrId pass)
=> Outputable (DerivDecl pass) where
instance (p ~ GhcPass pass, OutputableBndrId p)
=> Outputable (DerivDecl p) where
ppr (DerivDecl { deriv_type = ty
, deriv_strategy = ds
, deriv_overlap_mode = o })
......@@ -1722,9 +1716,8 @@ data DefaultDecl pass
-- For details on above see note [Api annotations] in ApiAnnotation
deriving instance (DataId pass) => Data (DefaultDecl pass)
instance (SourceTextX pass, OutputableBndrId pass)
=> Outputable (DefaultDecl pass) where
instance (p ~ GhcPass pass, OutputableBndrId p)
=> Outputable (DefaultDecl p) where
ppr (DefaultDecl tys)
= text "default" <+> parens (interpp'SP tys)
......@@ -1826,8 +1819,8 @@ data ForeignExport = CExport (Located CExportSpec) -- contains the calling
-- pretty printing of foreign declarations
--
instance (SourceTextX pass, OutputableBndrId pass)
=> Outputable (ForeignDecl pass) where
instance (p ~ GhcPass pass, OutputableBndrId p)
=> Outputable (ForeignDecl p) 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)
......@@ -1933,14 +1926,13 @@ collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ ty <- bndrs]
pprFullRuleName :: Located (SourceText, RuleName) -> SDoc
pprFullRuleName (L _ (st, n)) = pprWithSourceText st (doubleQuotes $ ftext n)
instance (SourceTextX pass, OutputableBndrId pass)
=> Outputable (RuleDecls pass) where
instance (p ~ GhcPass pass, OutputableBndrId p)
=> Outputable (RuleDecls p) where
ppr (HsRules st rules)
= pprWithSourceText st (text "{-# RULES")
<+> vcat (punctuate semi (map ppr rules)) <+> text "#-}"
instance (SourceTextX pass, OutputableBndrId pass)
=> Outputable (RuleDecl pass) where
instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (RuleDecl p) where
ppr (HsRule name act ns lhs _fv_lhs rhs _fv_rhs)
= sep [pprFullRuleName name <+> ppr act,
nest 4 (pp_forall <+> pprExpr (unLoc lhs)),
......@@ -1949,8 +1941,7 @@ instance (SourceTextX pass, OutputableBndrId pass)
pp_forall | null ns = empty
| otherwise = forAllLit <+> fsep (map ppr ns) <> dot
instance (SourceTextX pass, OutputableBndrId pass)
=> Outputable (RuleBndr pass) where
instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (RuleBndr p) where
ppr (RuleBndr name) = ppr name
ppr (RuleBndrSig name ty) = parens (ppr name <> dcolon <> ppr ty)
......@@ -2037,8 +2028,7 @@ lvectInstDecl (L _ (HsVectInstIn _)) = True
lvectInstDecl (L _ (HsVectInstOut _)) = True
lvectInstDecl _ = False
instance (SourceTextX pass, OutputableBndrId pass)
=> Outputable (VectDecl pass) where
instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (VectDecl p) where
ppr (HsVect _ v rhs)
= sep [text "{-# VECTORISE" <+> ppr v,
nest 4 $
......@@ -2159,8 +2149,7 @@ data AnnDecl pass = HsAnnotation
-- For details on above see note [Api annotations] in ApiAnnotation
deriving instance (DataId pass) => Data (AnnDecl pass)
instance (SourceTextX pass, OutputableBndrId pass)
=> Outputable (AnnDecl pass) where
instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (AnnDecl p) where
ppr (HsAnnotation _ provenance expr)
= hsep [text "{-#", pprAnnProvenance provenance, pprExpr (unLoc expr), text "#-}"]
......
This diff is collapsed.
......@@ -5,6 +5,7 @@
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE TypeFamilies #-}
module HsExpr where
......@@ -12,7 +13,7 @@ import SrcLoc ( Located )
import Outputable ( SDoc, Outputable )
import {-# SOURCE #-} HsPat ( LPat )
import BasicTypes ( SpliceExplicitFlag(..))
import HsExtension ( OutputableBndrId, DataId, SourceTextX )
import HsExtension ( OutputableBndrId, DataId, GhcPass )
import Data.Data hiding ( Fixity )
type role HsExpr nominal
......@@ -35,25 +36,24 @@ 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 (SourceTextX p, OutputableBndrId p) => Outputable (HsExpr p)
instance (SourceTextX p, OutputableBndrId p) => Outputable (HsCmd p)
instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsExpr p)
instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsCmd p)
type LHsExpr a = Located (HsExpr a)
pprLExpr :: (SourceTextX p, OutputableBndrId p) => LHsExpr p -> SDoc
pprLExpr :: (OutputableBndrId (GhcPass p)) => LHsExpr (GhcPass p) -> SDoc
pprExpr :: (SourceTextX p, OutputableBndrId p) => HsExpr p -> SDoc
pprExpr :: (OutputableBndrId (GhcPass p)) => HsExpr (GhcPass p) -> SDoc
pprSplice :: (SourceTextX p, OutputableBndrId p) => HsSplice p -> SDoc
pprSplice :: (OutputableBndrId (GhcPass p)) => HsSplice (GhcPass p) -> SDoc
pprSpliceDecl :: (SourceTextX p, OutputableBndrId p)
=> HsSplice p -> SpliceExplicitFlag -> SDoc
pprSpliceDecl :: (OutputableBndrId (GhcPass p))
=> HsSplice (GhcPass p) -> SpliceExplicitFlag -> SDoc
pprPatBind :: forall bndr p body. (SourceTextX p, SourceTextX bndr,
OutputableBndrId bndr,
OutputableBndrId p,
pprPatBind :: forall bndr p body. (OutputableBndrId (GhcPass bndr),
OutputableBndrId (GhcPass p),
Outputable body)
=> LPat bndr -> GRHSs p body -> SDoc
=> LPat (GhcPass bndr) -> GRHSs (GhcPass p) body -> SDoc
pprFunBind :: (SourceTextX idR, OutputableBndrId idR, Outputable body)
=> MatchGroup idR body -> SDoc
pprFunBind :: (OutputableBndrId (GhcPass idR), Outputable body)
=> MatchGroup (GhcPass idR) body -> SDoc
......@@ -124,91 +124,20 @@ type ForallX (c :: * -> Constraint) (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)