[Git][ghc/ghc][wip/ttg-cleanup] Minor TTG clean-up: comments, unused families, bottom
Vladislav Zavialov
gitlab at gitlab.haskell.org
Wed Sep 30 21:05:40 UTC 2020
Vladislav Zavialov pushed to branch wip/ttg-cleanup at Glasgow Haskell Compiler / GHC
Commits:
0cd0cece by Vladislav Zavialov at 2020-10-01T00:05:30+03:00
Minor TTG clean-up: comments, unused families, bottom
1. Fix and update section headers in GHC/Hs/Extension.hs
2. Delete the unused 'XCoreAnn' and 'XTickPragma' families
3. Avoid calls to 'panic' in 'pprStmt'
- - - - -
2 changed files:
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Hs/Extension.hs
Changes:
=====================================
compiler/GHC/Hs/Expr.hs
=====================================
@@ -847,7 +847,6 @@ data HsPragE p
| XHsPragE !(XXPragE p)
type instance XSCC (GhcPass _) = NoExtField
-type instance XCoreAnn (GhcPass _) = NoExtField
type instance XXPragE (GhcPass _) = NoExtCon
-- | Located Haskell Tuple Argument
@@ -2403,7 +2402,7 @@ pprStmt (LastStmt _ expr m_dollar_stripped _)
Just False -> text "return"
Nothing -> empty) <+>
ppr expr
-pprStmt (BindStmt _ pat expr) = hsep [ppr pat, larrow, ppr expr]
+pprStmt (BindStmt _ pat expr) = pprBindStmt pat expr
pprStmt (LetStmt _ (L _ binds)) = hsep [text "let", pprBinds binds]
pprStmt (BodyStmt _ expr _ _) = ppr expr
pprStmt (ParStmt _ stmtss _ _) = sep (punctuate (text " | ") (map ppr stmtss))
@@ -2439,11 +2438,8 @@ pprStmt (ApplicativeStmt _ args mb_join)
flattenArg :: forall a . (a, ApplicativeArg (GhcPass idL)) -> [SDoc]
flattenArg (_, ApplicativeArgOne _ pat expr isBody)
- | isBody = -- See Note [Applicative BodyStmt]
- [ppr (BodyStmt (panic "pprStmt") expr noSyntaxExpr noSyntaxExpr
- :: ExprStmt (GhcPass idL))]
- | otherwise =
- [ppr (BindStmt (panic "pprStmt") pat expr :: ExprStmt (GhcPass idL))]
+ | isBody = [ppr expr] -- See Note [Applicative BodyStmt]
+ | otherwise = [pprBindStmt pat expr]
flattenArg (_, ApplicativeArgMany _ stmts _ _ _) =
concatMap flattenStmt stmts
@@ -2457,6 +2453,8 @@ pprStmt (ApplicativeStmt _ args mb_join)
pp_arg :: (a, ApplicativeArg (GhcPass idL)) -> SDoc
pp_arg (_, applicativeArg) = ppr applicativeArg
+pprBindStmt :: (Outputable pat, Outputable expr) => pat -> expr -> SDoc
+pprBindStmt pat expr = hsep [ppr pat, larrow, ppr expr]
instance (OutputableBndrId idL)
=> Outputable (ApplicativeArg (GhcPass idL)) where
@@ -2464,18 +2462,13 @@ instance (OutputableBndrId idL)
pprArg :: forall idL . (OutputableBndrId idL) => ApplicativeArg (GhcPass idL) -> SDoc
pprArg (ApplicativeArgOne _ pat expr isBody)
- | isBody = -- See Note [Applicative BodyStmt]
- ppr (BodyStmt (panic "pprStmt") expr noSyntaxExpr noSyntaxExpr
- :: ExprStmt (GhcPass idL))
- | otherwise =
- ppr (BindStmt (panic "pprStmt") pat expr :: ExprStmt (GhcPass idL))
+ | isBody = ppr expr -- See Note [Applicative BodyStmt]
+ | otherwise = pprBindStmt pat expr
pprArg (ApplicativeArgMany _ stmts return pat ctxt) =
ppr pat <+>
text "<-" <+>
- ppr (HsDo (panic "pprStmt") ctxt (noLoc
- (stmts ++
- [noLoc (LastStmt noExtField (noLoc return) Nothing noSyntaxExpr)]))
- :: HsExpr (GhcPass idL))
+ pprDo ctxt (stmts ++
+ [noLoc (LastStmt noExtField (noLoc return) Nothing noSyntaxExpr)])
pprTransformStmt :: (OutputableBndrId p)
=> [IdP (GhcPass p)] -> LHsExpr (GhcPass p)
=====================================
compiler/GHC/Hs/Extension.hs
=====================================
@@ -331,11 +331,11 @@ type family XHsIPBinds x x'
type family XEmptyLocalBinds x x'
type family XXHsLocalBindsLR x x'
--- ValBindsLR type families
+-- HsValBindsLR type families
type family XValBinds x x'
type family XXValBindsLR x x'
--- HsBindsLR type families
+-- HsBindLR type families
type family XFunBind x x'
type family XPatBind x x'
type family XVarBind x x'
@@ -469,7 +469,7 @@ type family XCClsInstDecl x
type family XXClsInstDecl x
-- -------------------------------------
--- ClsInstDecl type families
+-- InstDecl type families
type family XClsInstD x
type family XDataFamInstD x
type family XTyFamInstD x
@@ -490,7 +490,7 @@ type family XCDefaultDecl x
type family XXDefaultDecl x
-- -------------------------------------
--- DefaultDecl type families
+-- ForeignDecl type families
type family XForeignImport x
type family XForeignExport x
type family XXForeignDecl x
@@ -517,7 +517,7 @@ type family XWarnings x
type family XXWarnDecls x
-- -------------------------------------
--- AnnDecl type families
+-- WarnDecl type families
type family XWarning x
type family XXWarnDecl x
@@ -574,32 +574,34 @@ type family XBinTick x
type family XPragE x
type family XXExpr x
+-- -------------------------------------
+-- HsPragE type families
type family XSCC x
-type family XCoreAnn x
-type family XTickPragma x
type family XXPragE x
--- ---------------------------------------------------------------------
+
+-- -------------------------------------
+-- AmbiguousFieldOcc type families
type family XUnambiguous x
type family XAmbiguous x
type family XXAmbiguousFieldOcc x
--- ----------------------------------------------------------------------
-
+-- -------------------------------------
+-- HsTupArg type families
type family XPresent x
type family XMissing x
type family XXTupArg x
--- ---------------------------------------------------------------------
-
+-- -------------------------------------
+-- HsSplice type families
type family XTypedSplice x
type family XUntypedSplice x
type family XQuasiQuote x
type family XSpliced x
type family XXSplice x
--- ---------------------------------------------------------------------
-
+-- -------------------------------------
+-- HsBracket type families
type family XExpBr x
type family XPatBr x
type family XDecBrL x
@@ -609,33 +611,33 @@ type family XVarBr x
type family XTExpBr x
type family XXBracket x
--- ---------------------------------------------------------------------
-
+-- -------------------------------------
+-- HsCmdTop type families
type family XCmdTop x
type family XXCmdTop x
-- -------------------------------------
-
+-- MatchGroup type families
type family XMG x b
type family XXMatchGroup x b
-- -------------------------------------
-
+-- Match type families
type family XCMatch x b
type family XXMatch x b
-- -------------------------------------
-
+-- GRHSs type families
type family XCGRHSs x b
type family XXGRHSs x b
-- -------------------------------------
-
+-- GRHS type families
type family XCGRHS x b
type family XXGRHS x b
-- -------------------------------------
-
+-- StmtLR type families
type family XLastStmt x x' b
type family XBindStmt x x' b
type family XApplicativeStmt x x' b
@@ -646,8 +648,8 @@ type family XTransStmt x x' b
type family XRecStmt x x' b
type family XXStmtLR x x' b
--- ---------------------------------------------------------------------
-
+-- -------------------------------------
+-- HsCmd type families
type family XCmdArrApp x
type family XCmdArrForm x
type family XCmdApp x
@@ -661,13 +663,13 @@ type family XCmdDo x
type family XCmdWrap x
type family XXCmd x
--- ---------------------------------------------------------------------
-
+-- -------------------------------------
+-- ParStmtBlock type families
type family XParStmtBlock x x'
type family XXParStmtBlock x x'
--- ---------------------------------------------------------------------
-
+-- -------------------------------------
+-- ApplicativeArg type families
type family XApplicativeArgOne x
type family XApplicativeArgMany x
type family XXApplicativeArg x
@@ -697,6 +699,8 @@ type family XHsFloatPrim x
type family XHsDoublePrim x
type family XXLit x
+-- -------------------------------------
+-- HsOverLit type families
type family XOverLit x
type family XXOverLit x
@@ -725,26 +729,29 @@ type family XXPat x
-- =====================================================================
-- Type families for the HsTypes type families
+
+-- -------------------------------------
+-- LHsQTyVars type families
type family XHsQTvs x
type family XXLHsQTyVars x
-- -------------------------------------
-
+-- HsImplicitBndrs type families
type family XHsIB x b
type family XXHsImplicitBndrs x b
-- -------------------------------------
-
+-- HsWildCardBndrs type families
type family XHsWC x b
type family XXHsWildCardBndrs x b
-- -------------------------------------
-
+-- HsPatSigType type families
type family XHsPS x
type family XXHsPatSigType x
-- -------------------------------------
-
+-- HsType type families
type family XForAllTy x
type family XQualTy x
type family XTyVar x
@@ -770,35 +777,37 @@ type family XWildCardTy x
type family XXType x
-- ---------------------------------------------------------------------
-
+-- HsForAllTelescope type families
type family XHsForAllVis x
type family XHsForAllInvis x
type family XXHsForAllTelescope x
-- ---------------------------------------------------------------------
-
+-- HsTyVarBndr type families
type family XUserTyVar x
type family XKindedTyVar x
type family XXTyVarBndr x
-- ---------------------------------------------------------------------
-
+-- ConDeclField type families
type family XConDeclField x
type family XXConDeclField x
-- ---------------------------------------------------------------------
-
+-- FieldOcc type families
type family XCFieldOcc x
type family XXFieldOcc x
-- =====================================================================
-- Type families for the HsImpExp type families
+-- -------------------------------------
+-- ImportDecl type families
type family XCImportDecl x
type family XXImportDecl x
-- -------------------------------------
-
+-- IE type families
type family XIEVar x
type family XIEThingAbs x
type family XIEThingAll x
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0cd0cece24b23d74c677ab04942f615852520734
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0cd0cece24b23d74c677ab04942f615852520734
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200930/85dfefe8/attachment-0001.html>
More information about the ghc-commits
mailing list