[Git][ghc/ghc][master] Minor TTG clean-up: comments, unused families, bottom

Marge Bot gitlab at gitlab.haskell.org
Fri Oct 2 17:52:05 UTC 2020



 Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
3c9beab7 by Vladislav Zavialov at 2020-10-02T13:51:58-04: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/3c9beab75aaa5fbbb11132c99e2af114f322152f

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3c9beab75aaa5fbbb11132c99e2af114f322152f
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/20201002/ae597a4c/attachment-0001.html>


More information about the ghc-commits mailing list