[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: Test case for #17652

Marge Bot gitlab at gitlab.haskell.org
Sun Aug 2 14:34:11 UTC 2020



 Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC


Commits:
e30fed6c by Vladislav Zavialov at 2020-08-01T04:23:04-04:00
Test case for #17652

The issue was fixed by 19e80b9af252eee760dc047765a9930ef00067ec

- - - - -
1a23a7dd by Ryan Scott at 2020-08-02T10:34:03-04:00
Remove ConDeclGADTPrefixPs

This removes the `ConDeclGADTPrefixPs` per the discussion in #18517.
Most of this patch simply removes code, although the code in the
`rnConDecl` case for `ConDeclGADTPrefixPs` had to be moved around a
bit:

* The nested `forall`s check now lives in the `rnConDecl` case for
  `ConDeclGADT`.
* The `LinearTypes`-specific code that used to live in the
  `rnConDecl` case for `ConDeclGADTPrefixPs` now lives in
  `GHC.Parser.PostProcess.mkGadtDecl`, which is now monadic so that
  it can check if `-XLinearTypes` is enabled.

Fixes #18157.

- - - - -
94bfcb1c by Leon Schoorl at 2020-08-02T10:34:03-04:00
Fix GHC_STAGE definition generated by make

Fixes #18070

GHC_STAGE is the stage of the compiler we're building, it should be 1,2(,3?).
But make was generating 0 and 1.

Hadrian does this correctly using a similar `+ 1`:
https://gitlab.haskell.org/ghc/ghc/-/blob/eb8115a8c4cbc842b66798480fefc7ab64d31931/hadrian/src/Rules/Generate.hs#L245

- - - - -


16 changed files:

- compiler/GHC/Hs/Decls.hs
- compiler/GHC/Hs/Instances.hs
- compiler/GHC/Hs/Type.hs
- compiler/GHC/Hs/Utils.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Parser/PostProcess/Haddock.hs
- compiler/GHC/Rename/Module.hs
- compiler/GHC/ThToHs.hs
- includes/ghc.mk
- testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr
- testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr
- + testsuite/tests/haddock/should_compile_flag_haddock/T17652.hs
- + testsuite/tests/haddock/should_compile_flag_haddock/T17652.stderr
- testsuite/tests/haddock/should_compile_flag_haddock/all.T
- testsuite/tests/parser/should_compile/T15323.stderr


Changes:

=====================================
compiler/GHC/Hs/Decls.hs
=====================================
@@ -71,7 +71,7 @@ module GHC.Hs.Decls (
   ForeignDecl(..), LForeignDecl, ForeignImport(..), ForeignExport(..),
   CImportSpec(..),
   -- ** Data-constructor declarations
-  ConDecl(..), LConDecl, ConDeclGADTPrefixPs(..),
+  ConDecl(..), LConDecl,
   HsConDeclDetails, hsConDeclArgTys, hsConDeclTheta,
   getConNames, getConArgs,
   -- ** Document comments
@@ -111,7 +111,6 @@ import GHC.Core.Coercion
 import GHC.Types.ForeignCall
 import GHC.Hs.Extension
 import GHC.Types.Name
-import GHC.Types.Name.Reader
 import GHC.Types.Name.Set
 
 -- others:
@@ -1437,12 +1436,13 @@ data ConDecl pass
       { con_g_ext   :: XConDeclGADT pass
       , con_names   :: [XRec pass (IdP pass)]
 
-      -- The next four fields describe the type after the '::'
+      -- The following fields describe the type after the '::'
       -- See Note [GADT abstract syntax]
-      -- The following field is Located to anchor API Annotations,
-      -- AnnForall and AnnDot.
       , con_forall  :: XRec pass Bool    -- ^ True <=> explicit forall
                                          --   False => hsq_explicit is empty
+                                         --
+                                         -- The 'XRec' is used to anchor API
+                                         -- annotations, AnnForall and AnnDot.
       , con_qvars   :: [LHsTyVarBndr Specificity pass]
                        -- Whether or not there is an /explicit/ forall, we still
                        -- need to capture the implicitly-bound type/kind variables
@@ -1479,25 +1479,18 @@ type instance XConDeclGADT GhcTc = NoExtField
 
 type instance XConDeclH98  (GhcPass _) = NoExtField
 
-type instance XXConDecl GhcPs = ConDeclGADTPrefixPs
-type instance XXConDecl GhcRn = NoExtCon
-type instance XXConDecl GhcTc = NoExtCon
-
--- | Stores the types of prefix GADT constructors in the parser. This is used
--- in lieu of ConDeclGADT, which requires knowing the specific argument and
--- result types, as this is difficult to determine in general in the parser.
--- See @Note [GADT abstract syntax]@.
-data ConDeclGADTPrefixPs = ConDeclGADTPrefixPs
-  { con_gp_names :: [Located RdrName]
-    -- ^ The GADT constructor declaration's names.
-  , con_gp_ty    :: LHsSigType GhcPs
-    -- ^ The type after the @::@.
-  , con_gp_doc   :: Maybe LHsDocString
-    -- ^ A possible Haddock comment.
-  }
+type instance XXConDecl (GhcPass _) = NoExtCon
 
 {- Note [GADT abstract syntax]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The types of both forms of GADT constructors are very structured, as they
+must consist of the quantified type variables (if provided), followed by the
+context (if provided), followed by the argument types (if provided), followed
+by the result type. (See "Wrinkle: No nested foralls or contexts" below for
+more discussion on the restrictions imposed here.) As a result, instead of
+storing the type of a GADT constructor as a single LHsType, we split it up
+into its constituent components for easier access.
+
 There are two broad ways to classify GADT constructors:
 
 * Record-syntax constructors. For example:
@@ -1510,48 +1503,45 @@ There are two broad ways to classify GADT constructors:
     data T a where
       K :: forall a. Ord a => [a] -> ... -> T a
 
-Initially, both forms of GADT constructors are initially parsed as a single
-LHsType. However, GADTs have a certain structure, requiring distinct argument
-and result types, as well as imposing restrictions on where `forall`s and
-contexts can be (see "Wrinkle: No nested foralls or contexts" below). As a
-result, it is convenient to split up the LHsType into its individual
-components, which are stored in the ConDeclGADT constructor of ConDecl.
-
-Where should this splitting occur? For GADT constructors with record syntax,
-we split in the parser (in GHC.Parser.PostProcess.mkGadtDecl). We must do this
-splitting before the renamer, as we need the record field names for use in
-GHC.Hs.Utils.hsConDeclsBinders.
+This distinction is recorded in the `con_args :: HsConDetails pass`, which
+tracks if we're dealing with a RecCon or PrefixCon. It is easy to distinguish
+the two in the AST since record GADT constructors use HsRecTy. This distinction
+is made in GHC.Parser.PostProcess.mkGadtDecl.
 
-For prefix GADT constructors, however, the situation is more complicated. It
-can be difficult to split a prefix GADT type until we know type operator
-fixities. Consider this, for example:
+It is worth elaborating a bit more on the process of splitting the argument
+types of a GADT constructor, since there are some non-obvious details involved.
+While splitting the argument types of a record GADT constructor is easy (they
+are stored in an HsRecTy), splitting the arguments of a prefix GADT constructor
+is trickier. The basic idea is that we must split along the outermost function
+arrows ((->) and (#->)) in the type, which GHC.Hs.Type.splitHsFunType
+accomplishes. But what about type operators? Consider:
 
   C :: a :*: b -> a :*: b -> a :+: b
 
-Initially, the type of C will parse as:
+This could parse in many different ways depending on the precedences of each
+type operator. In particular, if (:*:) were to have lower precedence than (->),
+then it could very well parse like this:
 
-  a :*: (b -> (a :*: (b -> (a :+: b))))
+  a :*: ((b -> a) :*: ((b -> a) :+: b)))
 
-So it's hard to split up the arguments until we've done the precedence
-resolution (in the renamer). (Unlike prefix GADT types, record GADT types
-do not have this problem because of their uniform syntax.)
+This would give the false impression that the whole type is part of one large
+return type, with no arguments. Note that we do not fully resolve the exact
+precedences of each user-defined type operator until the renamer, so this a
+more difficult task for the parser.
 
-As a result, we deliberately avoid splitting prefix GADT types in the parser.
-Instead, we store the entire LHsType in ConDeclGADTPrefixPs, a GHC-specific
-extension constructor to ConDecl. Later, in the renamer
-(in GHC.Rename.Module.rnConDecl), we resolve the fixities of all type operators
-in the LHsType, which facilitates splitting it into argument and result types
-accurately. We finish renaming a ConDeclGADTPrefixPs by putting the split
-components into a ConDeclGADT. This is why ConDeclGADTPrefixPs has the suffix
--Ps, as it is only used by the parser.
+Fortunately, there is no risk of the above happening. GHC's parser gives
+special treatment to function arrows, and as a result, they are always parsed
+with a lower precedence than any other type operator. As a result, the type
+above is actually parsed like this:
 
-Note that the existence of ConDeclGADTPrefixPs does not imply that ConDeclGADT
-goes completely unused by the parser. Other consumers of GHC's abstract syntax
-are still free to use ConDeclGADT. Indeed, both Haddock and Template Haskell
-construct values of type `ConDecl GhcPs` by way of ConDeclGADT, as neither of
-them have the same difficulties with operator precedence that GHC's parser
-does. As an example, see GHC.ThToHs.cvtConstr, which converts Template Haskell
-syntax into GHC syntax.
+  (a :*: b) -> ((a :*: b) -> (a :+: b))
+
+While we won't know the exact precedences of (:*:) and (:+:) until the renamer,
+all we are concerned about in the parser is identifying the overall shape of
+the argument and result types, which we can accomplish by piggybacking on the
+special treatment given to function arrows. In a future where function arrows
+aren't given special status in the parser, we will likely have to modify
+GHC.Parser.PostProcess.mergeOps to preserve this trick.
 
 -----
 -- Wrinkle: No nested foralls or contexts
@@ -1681,14 +1671,6 @@ pp_condecls cs
       []                      -> False
       (L _ ConDeclH98{}  : _) -> False
       (L _ ConDeclGADT{} : _) -> True
-      (L _ (XConDecl x)  : _) ->
-        case ghcPass @p of
-          GhcPs |  ConDeclGADTPrefixPs{} <- x
-                -> True
-#if __GLASGOW_HASKELL__ < 811
-          GhcRn -> noExtCon x
-          GhcTc -> noExtCon x
-#endif
 
 instance (OutputableBndrId p) => Outputable (ConDecl (GhcPass p)) where
     ppr = pprConDecl
@@ -1730,16 +1712,6 @@ pprConDecl (ConDeclGADT { con_names = cons, con_qvars = qvars
     ppr_arrow_chain (a:as) = sep (a : map (arrow <+>) as)
     ppr_arrow_chain []     = empty
 
-pprConDecl (XConDecl x) =
-  case ghcPass @p of
-    GhcPs |  ConDeclGADTPrefixPs { con_gp_names = cons, con_gp_ty = ty
-                                 , con_gp_doc = doc } <- x
-          -> ppr_mbDoc doc <+> ppr_con_names cons <+> dcolon <+> ppr ty
-#if __GLASGOW_HASKELL__ < 811
-    GhcRn -> noExtCon x
-    GhcTc -> noExtCon x
-#endif
-
 ppr_con_names :: (OutputableBndr a) => [Located a] -> SDoc
 ppr_con_names = pprWithCommas (pprPrefixOcc . unLoc)
 


=====================================
compiler/GHC/Hs/Instances.hs
=====================================
@@ -168,8 +168,6 @@ deriving instance Data (ConDecl GhcPs)
 deriving instance Data (ConDecl GhcRn)
 deriving instance Data (ConDecl GhcTc)
 
-deriving instance Data ConDeclGADTPrefixPs
-
 -- deriving instance DataIdLR p p   => Data (TyFamInstDecl p)
 deriving instance Data (TyFamInstDecl GhcPs)
 deriving instance Data (TyFamInstDecl GhcRn)


=====================================
compiler/GHC/Hs/Type.hs
=====================================
@@ -68,7 +68,7 @@ module GHC.Hs.Type (
         splitLHsInstDeclTy, getLHsInstDeclHead, getLHsInstDeclClass_maybe,
         splitLHsPatSynTy,
         splitLHsForAllTyInvis, splitLHsForAllTyInvis_KP, splitLHsQualTy,
-        splitLHsSigmaTyInvis, splitLHsGADTPrefixTy,
+        splitLHsSigmaTyInvis, splitLHsGadtTy,
         splitHsFunType, hsTyGetAppHead_maybe,
         mkHsOpTy, mkHsAppTy, mkHsAppTys, mkHsAppKindTy,
         ignoreParens, hsSigType, hsSigWcType, hsPatSigType,
@@ -1331,7 +1331,9 @@ mkHsAppKindTy ext ty k
 -- splitHsFunType decomposes a type (t1 -> t2 ... -> tn)
 -- Breaks up any parens in the result type:
 --      splitHsFunType (a -> (b -> c)) = ([a,b], c)
-splitHsFunType :: LHsType GhcRn -> ([HsScaled GhcRn (LHsType GhcRn)], LHsType GhcRn)
+splitHsFunType ::
+     LHsType (GhcPass p)
+  -> ([HsScaled (GhcPass p) (LHsType (GhcPass p))], LHsType (GhcPass p))
 splitHsFunType (L _ (HsParTy _ ty))
   = splitHsFunType ty
 
@@ -1460,7 +1462,7 @@ splitLHsSigmaTyInvis_KP ty
   , (mb_ctxt, ty2) <- splitLHsQualTy_KP ty1
   = (mb_tvbs, mb_ctxt, ty2)
 
--- | Decompose a prefix GADT type into its constituent parts.
+-- | Decompose a GADT type into its constituent parts.
 -- Returns @(mb_tvbs, mb_ctxt, body)@, where:
 --
 -- * @mb_tvbs@ are @Just@ the leading @forall at s, if they are provided.
@@ -1474,10 +1476,10 @@ splitLHsSigmaTyInvis_KP ty
 -- This function is careful not to look through parentheses.
 -- See @Note [GADT abstract syntax] (Wrinkle: No nested foralls or contexts)@
 -- "GHC.Hs.Decls" for why this is important.
-splitLHsGADTPrefixTy ::
+splitLHsGadtTy ::
      LHsType (GhcPass pass)
   -> (Maybe [LHsTyVarBndr Specificity (GhcPass pass)], Maybe (LHsContext (GhcPass pass)), LHsType (GhcPass pass))
-splitLHsGADTPrefixTy = splitLHsSigmaTyInvis_KP
+splitLHsGadtTy = splitLHsSigmaTyInvis_KP
 
 -- | Decompose a type of the form @forall <tvs>. body@ into its constituent
 -- parts. Only splits type variable binders that


=====================================
compiler/GHC/Hs/Utils.hs
=====================================
@@ -1265,16 +1265,6 @@ hsConDeclsBinders cons
                 (remSeen', flds) = get_flds remSeen args
                 (ns, fs) = go remSeen' rs
 
-           XConDecl x -> case ghcPass @p of
-             GhcPs |  ConDeclGADTPrefixPs { con_gp_names = names } <- x
-                   -> (map (L loc . unLoc) names ++ ns, fs)
-#if __GLASGOW_HASKELL__ < 811
-             GhcRn -> noExtCon x
-             GhcTc -> noExtCon x
-#endif
-             where
-               (ns, fs) = go remSeen rs
-
     get_flds :: Seen p -> HsConDeclDetails (GhcPass p)
              -> (Seen p, [LFieldOcc (GhcPass p)])
     get_flds remSeen (RecCon flds)


=====================================
compiler/GHC/Parser.y
=====================================
@@ -2176,8 +2176,9 @@ gadt_constr :: { LConDecl GhcPs }
     -- see Note [Difference in parsing GADT and data constructors]
     -- Returns a list because of:   C,D :: ty
         : optSemi con_list '::' sigtype
-                {% ams (sLL $2 $> (mkGadtDecl (unLoc $2) $4))
-                       [mu AnnDcolon $3] }
+                {% do { decl <- mkGadtDecl (unLoc $2) $4
+                      ; ams (sLL $2 $> decl)
+                            [mu AnnDcolon $3] } }
 
 {- Note [Difference in parsing GADT and data constructors]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~


=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -670,34 +670,41 @@ mkConDeclH98 name mb_forall mb_cxt args
                , con_doc    = Nothing }
 
 -- | Construct a GADT-style data constructor from the constructor names and
--- their type. This will return different AST forms for record syntax
--- constructors and prefix constructors, as the latter must be handled
--- specially in the renamer. See @Note [GADT abstract syntax]@ in
--- "GHC.Hs.Decls" for the full story.
+-- their type. Some interesting aspects of this function:
+--
+-- * This splits up the constructor type into its quantified type variables (if
+--   provided), context (if provided), argument types, and result type, and
+--   records whether this is a prefix or record GADT constructor. See
+--   Note [GADT abstract syntax] in "GHC.Hs.Decls" for more details.
+--
+-- * If -XLinearTypes is not enabled, the function arrows in a prefix GADT
+--   constructor are always interpreted as linear. If -XLinearTypes is enabled,
+--   we faithfully record whether -> or #-> was used.
 mkGadtDecl :: [Located RdrName]
            -> LHsType GhcPs
-           -> ConDecl GhcPs
-mkGadtDecl names ty
-  | Just (mtvs, mcxt, args, res_ty) <- mb_record_gadt ty
-  = ConDeclGADT { con_g_ext  = noExtField
-                , con_names  = names
-                , con_forall = L (getLoc ty) $ isJust mtvs
-                , con_qvars  = fromMaybe [] mtvs
-                , con_mb_cxt = mcxt
-                , con_args   = args
-                , con_res_ty = res_ty
-                , con_doc    = Nothing }
-  | otherwise
-  = XConDecl $ ConDeclGADTPrefixPs { con_gp_names = names
-                                   , con_gp_ty    = mkLHsSigType ty
-                                   , con_gp_doc   = Nothing }
+           -> P (ConDecl GhcPs)
+mkGadtDecl names ty = do
+  linearEnabled <- getBit LinearTypesBit
+
+  let (args, res_ty)
+        | L _ (HsFunTy _ _w (L loc (HsRecTy _ rf)) res_ty) <- body_ty
+        = (RecCon (L loc rf), res_ty)
+        | otherwise
+        = let (arg_types, res_type) = splitHsFunType body_ty
+              arg_types' | linearEnabled = arg_types
+                         | otherwise     = map (hsLinear . hsScaledThing) arg_types
+          in (PrefixCon arg_types', res_type)
+
+  pure $ ConDeclGADT { con_g_ext  = noExtField
+                     , con_names  = names
+                     , con_forall = L (getLoc ty) $ isJust mtvs
+                     , con_qvars  = fromMaybe [] mtvs
+                     , con_mb_cxt = mcxt
+                     , con_args   = args
+                     , con_res_ty = res_ty
+                     , con_doc    = Nothing }
   where
-    mb_record_gadt ty
-      | (mtvs, mcxt, body_ty) <- splitLHsGADTPrefixTy ty
-      , L _ (HsFunTy _ _w (L loc (HsRecTy _ rf)) res_ty) <- body_ty
-      = Just (mtvs, mcxt, RecCon (L loc rf), res_ty)
-      | otherwise
-      = Nothing
+    (mtvs, mcxt, body_ty) = splitLHsGadtTy ty
 
 setRdrNameSpace :: RdrName -> NameSpace -> RdrName
 -- ^ This rather gruesome function is used mainly by the parser.


=====================================
compiler/GHC/Parser/PostProcess/Haddock.hs
=====================================
@@ -716,15 +716,6 @@ instance HasHaddock (Located (ConDecl GhcPs)) where
               ConDeclH98 { con_ext, con_name, con_forall, con_ex_tvs, con_mb_cxt,
                            con_doc = con_doc',
                            con_args = RecCon (L l_rec flds') }
-      XConDecl (ConDeclGADTPrefixPs { con_gp_names, con_gp_ty }) -> do
-        -- discardHasInnerDocs is ok because we don't need this info for GADTs.
-        con_gp_doc' <- discardHasInnerDocs $ getConDoc (getLoc (head con_gp_names))
-        con_gp_ty' <- addHaddock con_gp_ty
-        pure $ L l_con_decl $
-          XConDecl (ConDeclGADTPrefixPs
-            { con_gp_names,
-              con_gp_ty = con_gp_ty',
-              con_gp_doc = con_gp_doc' })
 
 -- Keep track of documentation comments on the data constructor or any of its
 -- fields.


=====================================
compiler/GHC/Rename/Module.hs
=====================================
@@ -1856,7 +1856,6 @@ rnDataDefn doc (HsDataDefn { dd_ND = new_or_data, dd_cType = cType
   where
     h98_style = case condecls of  -- Note [Stupid theta]
                      (L _ (ConDeclGADT {}))                    : _ -> False
-                     (L _ (XConDecl (ConDeclGADTPrefixPs {}))) : _ -> False
                      _                                             -> True
 
     rn_derivs (L loc ds)
@@ -2246,6 +2245,12 @@ rnConDecl decl@(ConDeclGADT { con_names   = names
         ; (new_args, fvs2)   <- rnConDeclDetails (unLoc (head new_names)) ctxt args
         ; (new_res_ty, fvs3) <- rnLHsType ctxt res_ty
 
+         -- Ensure that there are no nested `forall`s or contexts, per
+         -- Note [GADT abstract syntax] (Wrinkle: No nested foralls or contexts)
+         -- in GHC.Hs.Type.
+       ; addNoNestedForallsContextsErr ctxt
+           (text "GADT constructor type signature") new_res_ty
+
         ; let all_fvs = fvs1 `plusFV` fvs2 `plusFV` fvs3
 
         ; traceRn "rnConDecl (ConDeclGADT)"
@@ -2257,47 +2262,6 @@ rnConDecl decl@(ConDeclGADT { con_names   = names
                        , con_forall = forall }, -- Remove when #18311 is fixed
                   all_fvs) } }
 
--- This case is only used for prefix GADT constructors generated by GHC's
--- parser, where we do not know the argument types until type operator
--- precedence has been resolved. See Note [GADT abstract syntax] in
--- GHC.Hs.Decls for the full story.
-rnConDecl (XConDecl (ConDeclGADTPrefixPs { con_gp_names = names, con_gp_ty = ty
-                                         , con_gp_doc = mb_doc }))
-  = do { mapM_ (addLocM checkConName) names
-       ; new_names <- mapM lookupLocatedTopBndrRn names
-       ; mb_doc'   <- rnMbLHsDoc mb_doc
-
-       ; let ctxt = ConDeclCtx new_names
-       ; (ty', fvs) <- rnHsSigType ctxt TypeLevel ty
-       ; linearTypes <- xopt LangExt.LinearTypes <$> getDynFlags
-
-         -- Now that operator precedence has been resolved, we can split the
-         -- GADT type into its individual components below.
-       ; let HsIB { hsib_ext = implicit_tkvs, hsib_body = body } = ty'
-             (mb_explicit_tkvs, mb_cxt, tau) = splitLHsGADTPrefixTy body
-             lhas_forall       = L (getLoc body) $ isJust mb_explicit_tkvs
-             explicit_tkvs     = fromMaybe [] mb_explicit_tkvs
-             (arg_tys, res_ty) = splitHsFunType tau
-             arg_details | linearTypes = PrefixCon arg_tys
-                         | otherwise   = PrefixCon $ map (hsLinear . hsScaledThing) arg_tys
-
-               -- NB: The only possibility here is PrefixCon. RecCon is handled
-               -- separately, through ConDeclGADT, from the parser onwards.
-
-         -- Ensure that there are no nested `forall`s or contexts, per
-         -- Note [GADT abstract syntax] (Wrinkle: No nested foralls or contexts)
-         -- in GHC.Hs.Type.
-       ; addNoNestedForallsContextsErr ctxt
-           (text "GADT constructor type signature") res_ty
-
-       ; traceRn "rnConDecl (ConDeclGADTPrefixPs)"
-           (ppr names $$ ppr implicit_tkvs $$ ppr explicit_tkvs)
-       ; pure (ConDeclGADT { con_g_ext = implicit_tkvs, con_names = new_names
-                           , con_forall = lhas_forall, con_qvars = explicit_tkvs
-                           , con_mb_cxt = mb_cxt, con_args = arg_details
-                           , con_res_ty = res_ty, con_doc = mb_doc' },
-               fvs) }
-
 rnMbContext :: HsDocContext -> Maybe (LHsContext GhcPs)
             -> RnM (Maybe (LHsContext GhcRn), FreeVars)
 rnMbContext _    Nothing    = return (Nothing, emptyFVs)


=====================================
compiler/GHC/ThToHs.hs
=====================================
@@ -611,14 +611,6 @@ cvtConstr (ForallC tvs ctxt con)
       where
         all_tvs = tvs' ++ ex_tvs
 
-    -- The GadtC and RecGadtC cases of cvtConstr will always return a
-    -- ConDeclGADT, not a ConDeclGADTPrefixPs, so this case is unreachable.
-    -- See Note [GADT abstract syntax] in GHC.Hs.Decls for more on the
-    -- distinction between ConDeclGADT and ConDeclGADTPrefixPs.
-    add_forall _ _ con@(XConDecl (ConDeclGADTPrefixPs {})) =
-      pprPanic "cvtConstr.add_forall: Unexpected ConDeclGADTPrefixPs"
-               (Outputable.ppr con)
-
 cvtConstr (GadtC [] _strtys _ty)
   = failWith (text "GadtC must have at least one constructor name")
 


=====================================
includes/ghc.mk
=====================================
@@ -163,7 +163,7 @@ $$(includes_$1_H_PLATFORM) : includes/ghc.mk includes/Makefile | $$$$(dir $$$$@)
 	@echo "#if !defined(__GHCPLATFORM_H__)"                      > $$@
 	@echo "#define __GHCPLATFORM_H__"                           >> $$@
 	@echo                                                       >> $$@
-	@echo "#define GHC_STAGE $1"                                >> $$@
+	@echo "#define GHC_STAGE ($1 + 1)"                          >> $$@
 	@echo                                                       >> $$@
 	@echo "#define BuildPlatform_TYPE  $(BuildPlatform_$1_CPP)" >> $$@
 	@echo "#define HostPlatform_TYPE   $(HostPlatform_$1_CPP)"  >> $$@


=====================================
testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr
=====================================
@@ -372,31 +372,35 @@
              (Nothing)
              (Nothing)
              [({ T17544.hs:25:5-18 }
-               (XConDecl
-                (ConDeclGADTPrefixPs
-                 [({ T17544.hs:25:5-8 }
-                   (Unqual
-                    {OccName: MkD5}))]
-                 (HsIB
+               (ConDeclGADT
+                (NoExtField)
+                [({ T17544.hs:25:5-8 }
+                  (Unqual
+                   {OccName: MkD5}))]
+                ({ T17544.hs:25:13-18 }
+                 (False))
+                []
+                (Nothing)
+                (PrefixCon
+                 [])
+                ({ T17544.hs:25:13-18 }
+                 (HsAppTy
                   (NoExtField)
-                  ({ T17544.hs:25:13-18 }
-                   (HsAppTy
+                  ({ T17544.hs:25:13-14 }
+                   (HsTyVar
                     (NoExtField)
+                    (NotPromoted)
                     ({ T17544.hs:25:13-14 }
-                     (HsTyVar
-                      (NoExtField)
-                      (NotPromoted)
-                      ({ T17544.hs:25:13-14 }
-                       (Unqual
-                        {OccName: D5}))))
+                     (Unqual
+                      {OccName: D5}))))
+                  ({ T17544.hs:25:16-18 }
+                   (HsTyVar
+                    (NoExtField)
+                    (NotPromoted)
                     ({ T17544.hs:25:16-18 }
-                     (HsTyVar
-                      (NoExtField)
-                      (NotPromoted)
-                      ({ T17544.hs:25:16-18 }
-                       (Unqual
-                        {OccName: Int})))))))
-                 (Nothing))))]
+                     (Unqual
+                      {OccName: Int}))))))
+                (Nothing)))]
              ({ <no location info> }
               []))))))]
        (Nothing)))))
@@ -504,31 +508,35 @@
              (Nothing)
              (Nothing)
              [({ T17544.hs:31:5-18 }
-               (XConDecl
-                (ConDeclGADTPrefixPs
-                 [({ T17544.hs:31:5-8 }
-                   (Unqual
-                    {OccName: MkD6}))]
-                 (HsIB
+               (ConDeclGADT
+                (NoExtField)
+                [({ T17544.hs:31:5-8 }
+                  (Unqual
+                   {OccName: MkD6}))]
+                ({ T17544.hs:31:13-18 }
+                 (False))
+                []
+                (Nothing)
+                (PrefixCon
+                 [])
+                ({ T17544.hs:31:13-18 }
+                 (HsAppTy
                   (NoExtField)
-                  ({ T17544.hs:31:13-18 }
-                   (HsAppTy
+                  ({ T17544.hs:31:13-14 }
+                   (HsTyVar
                     (NoExtField)
+                    (NotPromoted)
                     ({ T17544.hs:31:13-14 }
-                     (HsTyVar
-                      (NoExtField)
-                      (NotPromoted)
-                      ({ T17544.hs:31:13-14 }
-                       (Unqual
-                        {OccName: D6}))))
+                     (Unqual
+                      {OccName: D6}))))
+                  ({ T17544.hs:31:16-18 }
+                   (HsTyVar
+                    (NoExtField)
+                    (NotPromoted)
                     ({ T17544.hs:31:16-18 }
-                     (HsTyVar
-                      (NoExtField)
-                      (NotPromoted)
-                      ({ T17544.hs:31:16-18 }
-                       (Unqual
-                        {OccName: Int})))))))
-                 (Nothing))))]
+                     (Unqual
+                      {OccName: Int}))))))
+                (Nothing)))]
              ({ <no location info> }
               []))))))]
        (Nothing)))))
@@ -636,31 +644,35 @@
              (Nothing)
              (Nothing)
              [({ T17544.hs:37:5-18 }
-               (XConDecl
-                (ConDeclGADTPrefixPs
-                 [({ T17544.hs:37:5-8 }
-                   (Unqual
-                    {OccName: MkD7}))]
-                 (HsIB
+               (ConDeclGADT
+                (NoExtField)
+                [({ T17544.hs:37:5-8 }
+                  (Unqual
+                   {OccName: MkD7}))]
+                ({ T17544.hs:37:13-18 }
+                 (False))
+                []
+                (Nothing)
+                (PrefixCon
+                 [])
+                ({ T17544.hs:37:13-18 }
+                 (HsAppTy
                   (NoExtField)
-                  ({ T17544.hs:37:13-18 }
-                   (HsAppTy
+                  ({ T17544.hs:37:13-14 }
+                   (HsTyVar
                     (NoExtField)
+                    (NotPromoted)
                     ({ T17544.hs:37:13-14 }
-                     (HsTyVar
-                      (NoExtField)
-                      (NotPromoted)
-                      ({ T17544.hs:37:13-14 }
-                       (Unqual
-                        {OccName: D7}))))
+                     (Unqual
+                      {OccName: D7}))))
+                  ({ T17544.hs:37:16-18 }
+                   (HsTyVar
+                    (NoExtField)
+                    (NotPromoted)
                     ({ T17544.hs:37:16-18 }
-                     (HsTyVar
-                      (NoExtField)
-                      (NotPromoted)
-                      ({ T17544.hs:37:16-18 }
-                       (Unqual
-                        {OccName: Int})))))))
-                 (Nothing))))]
+                     (Unqual
+                      {OccName: Int}))))))
+                (Nothing)))]
              ({ <no location info> }
               []))))))]
        (Nothing)))))
@@ -768,31 +780,35 @@
              (Nothing)
              (Nothing)
              [({ T17544.hs:43:5-18 }
-               (XConDecl
-                (ConDeclGADTPrefixPs
-                 [({ T17544.hs:43:5-8 }
-                   (Unqual
-                    {OccName: MkD8}))]
-                 (HsIB
+               (ConDeclGADT
+                (NoExtField)
+                [({ T17544.hs:43:5-8 }
+                  (Unqual
+                   {OccName: MkD8}))]
+                ({ T17544.hs:43:13-18 }
+                 (False))
+                []
+                (Nothing)
+                (PrefixCon
+                 [])
+                ({ T17544.hs:43:13-18 }
+                 (HsAppTy
                   (NoExtField)
-                  ({ T17544.hs:43:13-18 }
-                   (HsAppTy
+                  ({ T17544.hs:43:13-14 }
+                   (HsTyVar
                     (NoExtField)
+                    (NotPromoted)
                     ({ T17544.hs:43:13-14 }
-                     (HsTyVar
-                      (NoExtField)
-                      (NotPromoted)
-                      ({ T17544.hs:43:13-14 }
-                       (Unqual
-                        {OccName: D8}))))
+                     (Unqual
+                      {OccName: D8}))))
+                  ({ T17544.hs:43:16-18 }
+                   (HsTyVar
+                    (NoExtField)
+                    (NotPromoted)
                     ({ T17544.hs:43:16-18 }
-                     (HsTyVar
-                      (NoExtField)
-                      (NotPromoted)
-                      ({ T17544.hs:43:16-18 }
-                       (Unqual
-                        {OccName: Int})))))))
-                 (Nothing))))]
+                     (Unqual
+                      {OccName: Int}))))))
+                (Nothing)))]
              ({ <no location info> }
               []))))))]
        (Nothing)))))
@@ -900,31 +916,35 @@
              (Nothing)
              (Nothing)
              [({ T17544.hs:49:5-18 }
-               (XConDecl
-                (ConDeclGADTPrefixPs
-                 [({ T17544.hs:49:5-8 }
-                   (Unqual
-                    {OccName: MkD9}))]
-                 (HsIB
+               (ConDeclGADT
+                (NoExtField)
+                [({ T17544.hs:49:5-8 }
+                  (Unqual
+                   {OccName: MkD9}))]
+                ({ T17544.hs:49:13-18 }
+                 (False))
+                []
+                (Nothing)
+                (PrefixCon
+                 [])
+                ({ T17544.hs:49:13-18 }
+                 (HsAppTy
                   (NoExtField)
-                  ({ T17544.hs:49:13-18 }
-                   (HsAppTy
+                  ({ T17544.hs:49:13-14 }
+                   (HsTyVar
                     (NoExtField)
+                    (NotPromoted)
                     ({ T17544.hs:49:13-14 }
-                     (HsTyVar
-                      (NoExtField)
-                      (NotPromoted)
-                      ({ T17544.hs:49:13-14 }
-                       (Unqual
-                        {OccName: D9}))))
+                     (Unqual
+                      {OccName: D9}))))
+                  ({ T17544.hs:49:16-18 }
+                   (HsTyVar
+                    (NoExtField)
+                    (NotPromoted)
                     ({ T17544.hs:49:16-18 }
-                     (HsTyVar
-                      (NoExtField)
-                      (NotPromoted)
-                      ({ T17544.hs:49:16-18 }
-                       (Unqual
-                        {OccName: Int})))))))
-                 (Nothing))))]
+                     (Unqual
+                      {OccName: Int}))))))
+                (Nothing)))]
              ({ <no location info> }
               []))))))]
        (Nothing)))))
@@ -1032,31 +1052,35 @@
              (Nothing)
              (Nothing)
              [({ T17544.hs:55:5-20 }
-               (XConDecl
-                (ConDeclGADTPrefixPs
-                 [({ T17544.hs:55:5-9 }
-                   (Unqual
-                    {OccName: MkD10}))]
-                 (HsIB
+               (ConDeclGADT
+                (NoExtField)
+                [({ T17544.hs:55:5-9 }
+                  (Unqual
+                   {OccName: MkD10}))]
+                ({ T17544.hs:55:14-20 }
+                 (False))
+                []
+                (Nothing)
+                (PrefixCon
+                 [])
+                ({ T17544.hs:55:14-20 }
+                 (HsAppTy
                   (NoExtField)
-                  ({ T17544.hs:55:14-20 }
-                   (HsAppTy
+                  ({ T17544.hs:55:14-16 }
+                   (HsTyVar
                     (NoExtField)
+                    (NotPromoted)
                     ({ T17544.hs:55:14-16 }
-                     (HsTyVar
-                      (NoExtField)
-                      (NotPromoted)
-                      ({ T17544.hs:55:14-16 }
-                       (Unqual
-                        {OccName: D10}))))
+                     (Unqual
+                      {OccName: D10}))))
+                  ({ T17544.hs:55:18-20 }
+                   (HsTyVar
+                    (NoExtField)
+                    (NotPromoted)
                     ({ T17544.hs:55:18-20 }
-                     (HsTyVar
-                      (NoExtField)
-                      (NotPromoted)
-                      ({ T17544.hs:55:18-20 }
-                       (Unqual
-                        {OccName: Int})))))))
-                 (Nothing))))]
+                     (Unqual
+                      {OccName: Int}))))))
+                (Nothing)))]
              ({ <no location info> }
               []))))))]
        (Nothing)))))


=====================================
testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr
=====================================
@@ -30,24 +30,28 @@
        (Nothing)
        (Nothing)
        [({ T17544_kw.hs:16:9-20 }
-         (XConDecl
-          (ConDeclGADTPrefixPs
-           [({ T17544_kw.hs:16:9-13 }
-             (Unqual
-              {OccName: MkFoo}))]
-           (HsIB
+         (ConDeclGADT
+          (NoExtField)
+          [({ T17544_kw.hs:16:9-13 }
+            (Unqual
+             {OccName: MkFoo}))]
+          ({ T17544_kw.hs:16:18-20 }
+           (False))
+          []
+          (Nothing)
+          (PrefixCon
+           [])
+          ({ T17544_kw.hs:16:18-20 }
+           (HsTyVar
             (NoExtField)
+            (NotPromoted)
             ({ T17544_kw.hs:16:18-20 }
-             (HsTyVar
-              (NoExtField)
-              (NotPromoted)
-              ({ T17544_kw.hs:16:18-20 }
-               (Unqual
-                {OccName: Foo})))))
-           (Just
-            ({ T17544_kw.hs:15:10-35 }
-             (HsDocString
-              " Bad comment for MkFoo"))))))]
+             (Unqual
+              {OccName: Foo}))))
+          (Just
+           ({ T17544_kw.hs:15:10-35 }
+            (HsDocString
+             " Bad comment for MkFoo")))))]
        ({ <no location info> }
         [])))))
   ,({ T17544_kw.hs:(18,1)-(19,26) }
@@ -70,33 +74,34 @@
        (Nothing)
        (Nothing)
        [({ T17544_kw.hs:19:9-26 }
-         (XConDecl
-          (ConDeclGADTPrefixPs
-           [({ T17544_kw.hs:19:9-13 }
-             (Unqual
-              {OccName: MkBar}))]
-           (HsIB
+         (ConDeclGADT
+          (NoExtField)
+          [({ T17544_kw.hs:19:9-13 }
+            (Unqual
+             {OccName: MkBar}))]
+          ({ T17544_kw.hs:19:18-26 }
+           (False))
+          []
+          (Nothing)
+          (PrefixCon
+           [(HsScaled
+             (HsLinearArrow)
+             ({ T17544_kw.hs:19:18-19 }
+              (HsTupleTy
+               (NoExtField)
+               (HsBoxedOrConstraintTuple)
+               [])))])
+          ({ T17544_kw.hs:19:24-26 }
+           (HsTyVar
             (NoExtField)
-            ({ T17544_kw.hs:19:18-26 }
-             (HsFunTy
-              (NoExtField)
-              (HsUnrestrictedArrow)
-              ({ T17544_kw.hs:19:18-19 }
-               (HsTupleTy
-                (NoExtField)
-                (HsBoxedOrConstraintTuple)
-                []))
-              ({ T17544_kw.hs:19:24-26 }
-               (HsTyVar
-                (NoExtField)
-                (NotPromoted)
-                ({ T17544_kw.hs:19:24-26 }
-                 (Unqual
-                  {OccName: Bar})))))))
-           (Just
-            ({ T17544_kw.hs:18:13-38 }
-             (HsDocString
-              " Bad comment for MkBar"))))))]
+            (NotPromoted)
+            ({ T17544_kw.hs:19:24-26 }
+             (Unqual
+              {OccName: Bar}))))
+          (Just
+           ({ T17544_kw.hs:18:13-38 }
+            (HsDocString
+             " Bad comment for MkBar")))))]
        ({ <no location info> }
         [])))))
   ,({ T17544_kw.hs:(21,1)-(24,18) }


=====================================
testsuite/tests/haddock/should_compile_flag_haddock/T17652.hs
=====================================
@@ -0,0 +1,8 @@
+module T17652 where
+
+data X
+  = B
+     -- | x
+     !Int
+     -- | y
+     String


=====================================
testsuite/tests/haddock/should_compile_flag_haddock/T17652.stderr
=====================================
@@ -0,0 +1,6 @@
+
+==================== Parser ====================
+module T17652 where
+data X = B !Int " x" String " y"
+
+


=====================================
testsuite/tests/haddock/should_compile_flag_haddock/all.T
=====================================
@@ -62,3 +62,4 @@ test('T17544_kw', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed-as
 test('haddockExtraDocs', normal, compile, ['-haddock -Winvalid-haddock'])
 test('haddockTySyn', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed'])
 test('T8944', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed'])
+test('T17652', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed'])


=====================================
testsuite/tests/parser/should_compile/T15323.stderr
=====================================
@@ -36,67 +36,62 @@
        (Nothing)
        (Nothing)
        [({ T15323.hs:6:5-54 }
-         (XConDecl
-          (ConDeclGADTPrefixPs
-           [({ T15323.hs:6:5-14 }
-             (Unqual
-              {OccName: TestParens}))]
-           (HsIB
+         (ConDeclGADT
+          (NoExtField)
+          [({ T15323.hs:6:5-14 }
+            (Unqual
+             {OccName: TestParens}))]
+          ({ T15323.hs:6:20-54 }
+           (True))
+          [({ T15323.hs:6:27 }
+            (UserTyVar
+             (NoExtField)
+             (SpecifiedSpec)
+             ({ T15323.hs:6:27 }
+              (Unqual
+               {OccName: v}))))]
+          (Just
+           ({ T15323.hs:6:31-36 }
+            [({ T15323.hs:6:31-36 }
+              (HsParTy
+               (NoExtField)
+               ({ T15323.hs:6:32-35 }
+                (HsAppTy
+                 (NoExtField)
+                 ({ T15323.hs:6:32-33 }
+                  (HsTyVar
+                   (NoExtField)
+                   (NotPromoted)
+                   ({ T15323.hs:6:32-33 }
+                    (Unqual
+                     {OccName: Eq}))))
+                 ({ T15323.hs:6:35 }
+                  (HsTyVar
+                   (NoExtField)
+                   (NotPromoted)
+                   ({ T15323.hs:6:35 }
+                    (Unqual
+                     {OccName: v}))))))))]))
+          (PrefixCon
+           [])
+          ({ T15323.hs:6:41-54 }
+           (HsAppTy
             (NoExtField)
-            ({ T15323.hs:6:20-54 }
-             (HsForAllTy
+            ({ T15323.hs:6:41-52 }
+             (HsTyVar
               (NoExtField)
-              (HsForAllInvis
-               (NoExtField)
-               [({ T15323.hs:6:27 }
-                 (UserTyVar
-                  (NoExtField)
-                  (SpecifiedSpec)
-                  ({ T15323.hs:6:27 }
-                   (Unqual
-                    {OccName: v}))))])
-              ({ T15323.hs:6:31-54 }
-               (HsQualTy
-                (NoExtField)
-                ({ T15323.hs:6:31-36 }
-                 [({ T15323.hs:6:31-36 }
-                   (HsParTy
-                    (NoExtField)
-                    ({ T15323.hs:6:32-35 }
-                     (HsAppTy
-                      (NoExtField)
-                      ({ T15323.hs:6:32-33 }
-                       (HsTyVar
-                        (NoExtField)
-                        (NotPromoted)
-                        ({ T15323.hs:6:32-33 }
-                         (Unqual
-                          {OccName: Eq}))))
-                      ({ T15323.hs:6:35 }
-                       (HsTyVar
-                        (NoExtField)
-                        (NotPromoted)
-                        ({ T15323.hs:6:35 }
-                         (Unqual
-                          {OccName: v}))))))))])
-                ({ T15323.hs:6:41-54 }
-                 (HsAppTy
-                  (NoExtField)
-                  ({ T15323.hs:6:41-52 }
-                   (HsTyVar
-                    (NoExtField)
-                    (NotPromoted)
-                    ({ T15323.hs:6:41-52 }
-                     (Unqual
-                      {OccName: MaybeDefault}))))
-                  ({ T15323.hs:6:54 }
-                   (HsTyVar
-                    (NoExtField)
-                    (NotPromoted)
-                    ({ T15323.hs:6:54 }
-                     (Unqual
-                      {OccName: v})))))))))))
-           (Nothing))))]
+              (NotPromoted)
+              ({ T15323.hs:6:41-52 }
+               (Unqual
+                {OccName: MaybeDefault}))))
+            ({ T15323.hs:6:54 }
+             (HsTyVar
+              (NoExtField)
+              (NotPromoted)
+              ({ T15323.hs:6:54 }
+               (Unqual
+                {OccName: v}))))))
+          (Nothing)))]
        ({ <no location info> }
         [])))))]
   (Nothing)



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e419766777b5fea9628314b082f8a411ca9727da...94bfcb1c7e77d0624990c7330ff019d84c2d87c5

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e419766777b5fea9628314b082f8a411ca9727da...94bfcb1c7e77d0624990c7330ff019d84c2d87c5
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/20200802/c89f9080/attachment-0001.html>


More information about the ghc-commits mailing list