[Git][ghc/ghc][wip/T18844] Split HsConDecl{H98,GADT}Details
Ryan Scott
gitlab at gitlab.haskell.org
Sat Oct 17 15:07:26 UTC 2020
Ryan Scott pushed to branch wip/T18844 at Glasgow Haskell Compiler / GHC
Commits:
037ced55 by Ryan Scott at 2020-10-17T11:06:55-04:00
Split HsConDecl{H98,GADT}Details
Haskell98 and GADT constructors both use `HsConDeclDetails`, which includes
`InfixCon`. But `InfixCon` is never used for GADT constructors, which results
in an awkward unrepresentable state. This removes the unrepresentable state by:
* Adding a third type parameter to `HsConDeclDetails` to represent the types
in an `InfixCon`, separate from the type parameters for `PrefixCon` and
`RecCon`, and
* Creating `HsConDeclH98Details` and `HsConDeclGADTDetails` synonyms on top
of the new `HsConDeclDetails`, which instantiate the `inf` type parameter
to `HsScaled pass (LBangType pass)` and `Void`, respectively. Using `Void`
allows functions that consume `HsConDeclGADTDetails` to simply call `absurd`
instead of having to, say, `panic`.
The rest of the patch is refactoring to accommodate the new structure of
`HsConDecl{,H98,GADT}Details`. Some highlights:
* The `getConArgs` and `hsConDeclArgTys` functions have been removed, as
there is no way to implement these functions uniformly for all
`ConDecl`s. For the most part, their previous call sites now
pattern match on the `ConDecl`s directly and do different things for
`ConDeclH98`s and `ConDeclGADT`s.
I did introduce one new function to make the transition easier:
`getRecConArgs_maybe`, which extracts the arguments from a `RecCon`.
This is still possible since `RecCon`s still use the same representation
in both `HsConDeclH98Details` and `HsConDeclGADTDetails`, and since the
pattern that `getRecConArgs_maybe` implements is used in several places,
I thought it worthwhile to factor it out into its own function.
* Previously, the `con_args` fields in `ConDeclH98` and `ConDeclGADT` were
both of type `HsConDeclDetails`. Now, the former is of type
`HsConDeclH98Details`, and the latter is of type `HsConDeclGADTDetails`,
which are distinct types. As a result, I had to rename the `con_args` field
in `ConDeclGADT` to `con_g_args` to make it typecheck.
A consequence of all this is that the `con_args` field is now partial, so
using `con_args` as a top-level field selector is dangerous. (Indeed, Haddock
was using `con_args` at the top-level, which caused it to crash at runtime
before I noticed what was wrong!) I decided to add a disclaimer in the 9.2.1
release notes to advertise this pitfall.
TODO: Say the magic words about T18844. Bumps the `haddock` submodule.
[ci skip] (TODO: Remove this)
- - - - -
18 changed files:
- compiler/GHC/Hs/Binds.hs
- compiler/GHC/Hs/Decls.hs
- compiler/GHC/Hs/Pat.hs
- compiler/GHC/Hs/Type.hs
- compiler/GHC/Hs/Utils.hs
- compiler/GHC/HsToCore/Docs.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Parser/PostProcess/Haddock.hs
- compiler/GHC/Rename/HsType.hs
- compiler/GHC/Rename/Module.hs
- compiler/GHC/Rename/Names.hs
- compiler/GHC/Tc/TyCl.hs
- compiler/GHC/ThToHs.hs
- docs/users_guide/9.2.1-notes.rst
- utils/haddock
Changes:
=====================================
compiler/GHC/Hs/Binds.hs
=====================================
@@ -1227,7 +1227,10 @@ pprMinimalSig (L _ bf) = ppr (fmap unLoc bf)
-}
-- | Haskell Pattern Synonym Details
-type HsPatSynDetails pass = HsConDetails (LIdP pass) [RecordPatSynField (LIdP pass)]
+type HsPatSynDetails pass
+ = HsConDetails (LIdP pass)
+ [RecordPatSynField (LIdP pass)]
+ (LIdP pass)
-- See Note [Record PatSyn Fields]
-- | Record Pattern Synonym Field
=====================================
compiler/GHC/Hs/Decls.hs
=====================================
@@ -74,8 +74,9 @@ module GHC.Hs.Decls (
CImportSpec(..),
-- ** Data-constructor declarations
ConDecl(..), LConDecl,
- HsConDeclDetails, hsConDeclArgTys, hsConDeclTheta,
- getConNames, getConArgs,
+ HsConDeclDetails, HsConDeclH98Details, HsConDeclGADTDetails,
+ hsConDeclTheta,
+ getConNames, getRecConArgs_maybe,
-- ** Document comments
DocDecl(..), LDocDecl, docDeclDoc,
-- ** Deprecations
@@ -126,6 +127,7 @@ import GHC.Core.Type
import GHC.Data.Bag
import GHC.Data.Maybe
import Data.Data hiding (TyCon,Fixity, Infix)
+import Data.Void
{-
************************************************************************
@@ -1473,9 +1475,9 @@ data ConDecl pass
-- Whether or not there is an /explicit/ forall, we still
-- need to capture the implicitly-bound type/kind variables
- , con_mb_cxt :: Maybe (LHsContext pass) -- ^ User-written context (if any)
- , con_args :: HsConDeclDetails pass -- ^ Arguments; never InfixCon
- , con_res_ty :: LHsType pass -- ^ Result type
+ , con_mb_cxt :: Maybe (LHsContext pass) -- ^ User-written context (if any)
+ , con_g_args :: HsConDeclGADTDetails pass -- ^ Arguments; never InfixCon
+ , con_res_ty :: LHsType pass -- ^ Result type
, con_doc :: Maybe LHsDocString
-- ^ A possible Haddock comment.
@@ -1492,7 +1494,7 @@ data ConDecl pass
-- False => con_ex_tvs is empty
, con_ex_tvs :: [LHsTyVarBndr Specificity pass] -- ^ Existentials only
, con_mb_cxt :: Maybe (LHsContext pass) -- ^ User-written context (if any)
- , con_args :: HsConDeclDetails pass -- ^ Arguments; can be InfixCon
+ , con_args :: HsConDeclH98Details pass -- ^ Arguments; can be InfixCon
, con_doc :: Maybe LHsDocString
-- ^ A possible Haddock comment.
@@ -1623,27 +1625,39 @@ or contexts in two parts:
quantification occurs after a visible argument type.
-}
--- | Haskell data Constructor Declaration Details
-type HsConDeclDetails pass
- = HsConDetails (HsScaled pass (LBangType pass)) (XRec pass [LConDeclField pass])
+-- | The arguments in a data constructor declaration. The @inf@ type parameter
+-- represents the representation for infix data constructors, which is
+-- different depending on whether the data constructor is Haskell98-style or
+-- GADT-style.
+type HsConDeclDetails pass inf
+ = HsConDetails (HsScaled pass (LBangType pass))
+ (XRec pass [LConDeclField pass])
+ inf
+
+-- | The arguments in a Haskell98 data constructor, which can be infix.
+type HsConDeclH98Details pass
+ = HsConDeclDetails pass (HsScaled pass (LBangType pass))
+
+-- | The arguments in a GADT constructor, which cannot be infix.
+type HsConDeclGADTDetails pass
+ = HsConDeclDetails pass Void
getConNames :: ConDecl GhcRn -> [Located Name]
getConNames ConDeclH98 {con_name = name} = [name]
getConNames ConDeclGADT {con_names = names} = names
-getConArgs :: ConDecl GhcRn -> HsConDeclDetails GhcRn
-getConArgs d = con_args d
-
-hsConDeclArgTys :: HsConDeclDetails (GhcPass p) -> [HsScaled (GhcPass p) (LBangType (GhcPass p))]
-hsConDeclArgTys (PrefixCon tys) = tys
-hsConDeclArgTys (InfixCon ty1 ty2) = [ty1,ty2]
-hsConDeclArgTys (RecCon flds) = map (hsLinear . cd_fld_type . unLoc) (unLoc flds)
- -- Remark: with the record syntax, constructors have all their argument
- -- linear, despite the fact that projections do not make sense on linear
- -- constructors. The design here is that the record projection themselves are
- -- typed to take an unrestricted argument (that is the record itself is
- -- unrestricted). By the transfer property, projections are then correct in
- -- that all the non-projected fields have multiplicity Many, and can be dropped.
+-- | Return @'Just' fields@ if a data constructor declaration uses record
+-- syntax (i.e., 'RecCon'), where @fields@ are the field selectors.
+-- Otherwise, return 'Nothing'.
+getRecConArgs_maybe :: ConDecl GhcRn -> Maybe (Located [LConDeclField GhcRn])
+getRecConArgs_maybe (ConDeclH98{con_args = args}) = case args of
+ PrefixCon{} -> Nothing
+ RecCon flds -> Just flds
+ InfixCon{} -> Nothing
+getRecConArgs_maybe (ConDeclGADT{con_g_args = args}) = case args of
+ PrefixCon{} -> Nothing
+ RecCon flds -> Just flds
+ InfixCon v _ -> absurd v
hsConDeclTheta :: Maybe (LHsContext (GhcPass p)) -> [LHsType (GhcPass p)]
hsConDeclTheta Nothing = []
@@ -1723,7 +1737,7 @@ pprConDecl (ConDeclH98 { con_name = L _ con
cxt = fromMaybe noLHsContext mcxt
pprConDecl (ConDeclGADT { con_names = cons, con_qvars = qvars
- , con_mb_cxt = mcxt, con_args = args
+ , con_mb_cxt = mcxt, con_g_args = args
, con_res_ty = res_ty, con_doc = doc })
= ppr_mbDoc doc <+> ppr_con_names cons <+> dcolon
<+> (sep [pprHsForAll (mkHsForAllInvisTele qvars) cxt,
=====================================
compiler/GHC/Hs/Pat.hs
=====================================
@@ -316,7 +316,7 @@ type instance ConLikeP GhcTc = ConLike
-- | Haskell Constructor Pattern Details
-type HsConPatDetails p = HsConDetails (LPat p) (HsRecFields p (LPat p))
+type HsConPatDetails p = HsConDetails (LPat p) (HsRecFields p (LPat p)) (LPat p)
hsConPatArgs :: HsConPatDetails p -> [LPat p]
hsConPatArgs (PrefixCon ps) = ps
@@ -866,7 +866,7 @@ patNeedsParens p = go
-- | @'conPatNeedsParens' p cp@ returns 'True' if the constructor patterns @cp@
-- needs parentheses under precedence @p at .
-conPatNeedsParens :: PprPrec -> HsConDetails a b -> Bool
+conPatNeedsParens :: PprPrec -> HsConDetails a b c -> Bool
conPatNeedsParens p = go
where
go (PrefixCon args) = p >= appPrec && not (null args)
=====================================
compiler/GHC/Hs/Type.hs
=====================================
@@ -1101,14 +1101,14 @@ instance OutputableBndrId p
-- HsConDetails is used for patterns/expressions *and* for data type
-- declarations
-- | Haskell Constructor Details
-data HsConDetails arg rec
+data HsConDetails arg rec inf
= PrefixCon [arg] -- C p1 p2 p3
| RecCon rec -- C { x = p1, y = p2 }
- | InfixCon arg arg -- p1 `C` p2
+ | InfixCon inf inf -- p1 `C` p2
deriving Data
-instance (Outputable arg, Outputable rec)
- => Outputable (HsConDetails arg rec) where
+instance (Outputable arg, Outputable rec, Outputable inf)
+ => Outputable (HsConDetails arg rec inf) where
ppr (PrefixCon args) = text "PrefixCon" <+> ppr args
ppr (RecCon rec) = text "RecCon:" <+> ppr rec
ppr (InfixCon l r) = text "InfixCon:" <+> ppr [l, r]
=====================================
compiler/GHC/Hs/Utils.hs
=====================================
@@ -1255,7 +1255,7 @@ hsConDeclsBinders cons
in case unLoc r of
-- remove only the first occurrence of any seen field in order to
-- avoid circumventing detection of duplicate fields (#9156)
- ConDeclGADT { con_names = names, con_args = args }
+ ConDeclGADT { con_names = names, con_g_args = args }
-> (map (L loc . unLoc) names ++ ns, flds ++ fs)
where
(remSeen', flds) = get_flds remSeen args
@@ -1267,7 +1267,7 @@ hsConDeclsBinders cons
(remSeen', flds) = get_flds remSeen args
(ns, fs) = go remSeen' rs
- get_flds :: Seen p -> HsConDeclDetails (GhcPass p)
+ get_flds :: Seen p -> HsConDeclDetails (GhcPass p) inf
-> (Seen p, [LFieldOcc (GhcPass p)])
get_flds remSeen (RecCon flds)
= (remSeen', fld_names)
=====================================
compiler/GHC/HsToCore/Docs.hs
=====================================
@@ -31,6 +31,7 @@ import Data.Map (Map)
import qualified Data.Map as M
import Data.Maybe
import Data.Semigroup
+import Data.Void
-- | Extract docs from renamer output.
extractDocs :: TcGblEnv
@@ -189,7 +190,7 @@ subordinates instMap decl = case decl of
, conArgDocs c)
| c <- cons, cname <- getConNames c ]
fields = [ (extFieldOcc n, maybeToList $ fmap unLoc doc, M.empty)
- | RecCon flds <- map getConArgs cons
+ | Just flds <- map getRecConArgs_maybe cons
, (L _ (ConDeclField _ ns _ doc)) <- (unLoc flds)
, (L _ n) <- ns ]
derivs = [ (instName, [unLoc doc], M.empty)
@@ -216,22 +217,31 @@ subordinates instMap decl = case decl of
_ -> Nothing
-- | Extract constructor argument docs from inside constructor decls.
-conArgDocs :: ConDecl GhcRn -> Map Int (HsDocString)
-conArgDocs con = case getConArgs con of
- PrefixCon args -> go 0 (map (unLoc . hsScaledThing) args ++ ret)
- InfixCon arg1 arg2 -> go 0 ([unLoc (hsScaledThing arg1),
- unLoc (hsScaledThing arg2)] ++ ret)
- RecCon _ -> go 1 ret
+conArgDocs :: ConDecl GhcRn -> Map Int HsDocString
+conArgDocs (ConDeclH98{con_args = args}) =
+ h98ConArgDocs args
+conArgDocs (ConDeclGADT{con_g_args = args, con_res_ty = res_ty}) =
+ gadtConArgDocs args (unLoc res_ty)
+
+h98ConArgDocs :: HsConDeclH98Details GhcRn -> Map Int HsDocString
+h98ConArgDocs con_args = case con_args of
+ PrefixCon args -> con_arg_docs 0 $ map (unLoc . hsScaledThing) args
+ InfixCon arg1 arg2 -> con_arg_docs 0 [ unLoc (hsScaledThing arg1)
+ , unLoc (hsScaledThing arg2) ]
+ RecCon _ -> M.empty
+
+gadtConArgDocs :: HsConDeclGADTDetails GhcRn -> HsType GhcRn -> Map Int HsDocString
+gadtConArgDocs con_args res_ty = case con_args of
+ PrefixCon args -> con_arg_docs 0 $ map (unLoc . hsScaledThing) args ++ [res_ty]
+ InfixCon v _ -> absurd v
+ RecCon _ -> con_arg_docs 1 [res_ty]
+
+con_arg_docs :: Int -> [HsType GhcRn] -> Map Int HsDocString
+con_arg_docs n = M.fromList . catMaybes . zipWith f [n..]
where
- go n = M.fromList . catMaybes . zipWith f [n..]
- where
- f n (HsDocTy _ _ lds) = Just (n, unLoc lds)
- f n (HsBangTy _ _ (L _ (HsDocTy _ _ lds))) = Just (n, unLoc lds)
- f _ _ = Nothing
-
- ret = case con of
- ConDeclGADT { con_res_ty = res_ty } -> [ unLoc res_ty ]
- _ -> []
+ f n (HsDocTy _ _ lds) = Just (n, unLoc lds)
+ f n (HsBangTy _ _ (L _ (HsDocTy _ _ lds))) = Just (n, unLoc lds)
+ f _ _ = Nothing
isValD :: HsDecl a -> Bool
isValD (ValD _ _) = True
=====================================
compiler/GHC/HsToCore/Quote.hs
=====================================
@@ -85,6 +85,7 @@ import Data.ByteString ( unpack )
import Control.Monad
import Data.List
import Data.Function
+import Data.Void
data MetaWrappers = MetaWrappers {
-- Applies its argument to a type argument `m` and dictionary `Quote m`
@@ -869,7 +870,7 @@ repC (L _ (ConDeclH98 { con_name = con
, con_forall = (L _ False)
, con_mb_cxt = Nothing
, con_args = args }))
- = repDataCon con args
+ = repH98DataCon con args
repC (L _ (ConDeclH98 { con_name = con
, con_forall = L _ is_existential
@@ -877,7 +878,7 @@ repC (L _ (ConDeclH98 { con_name = con
, con_mb_cxt = mcxt
, con_args = args }))
= do { addHsTyVarBinds con_tvs $ \ ex_bndrs ->
- do { c' <- repDataCon con args
+ do { c' <- repH98DataCon con args
; ctxt' <- repMbContext mcxt
; if not is_existential && isNothing mcxt
then return c'
@@ -889,7 +890,7 @@ repC (L _ (ConDeclGADT { con_g_ext = imp_tvs
, con_names = cons
, con_qvars = exp_tvs
, con_mb_cxt = mcxt
- , con_args = args
+ , con_g_args = args
, con_res_ty = res_ty }))
| null imp_tvs && null exp_tvs -- No implicit or explicit variables
, Nothing <- mcxt -- No context
@@ -2581,49 +2582,52 @@ repImplicitParamBind (MkC n) (MkC e) = rep2 implicitParamBindDName [n, e]
repCtxt :: Core [(M TH.Pred)] -> MetaM (Core (M TH.Cxt))
repCtxt (MkC tys) = rep2 cxtName [tys]
-repDataCon :: Located Name
- -> HsConDeclDetails GhcRn
- -> MetaM (Core (M TH.Con))
-repDataCon con details
+repH98DataCon :: Located Name
+ -> HsConDeclH98Details GhcRn
+ -> MetaM (Core (M TH.Con))
+repH98DataCon con details
= do con' <- lookupLOcc con -- See Note [Binders and occurrences]
- repConstr details Nothing [con']
+ case details of
+ PrefixCon ps -> do
+ arg_tys <- repPrefixConArgs ps
+ rep2 normalCName [unC con', unC arg_tys]
+ InfixCon st1 st2 -> do
+ arg1 <- repBangTy (hsScaledThing st1)
+ arg2 <- repBangTy (hsScaledThing st2)
+ rep2 infixCName [unC arg1, unC con', unC arg2]
+ RecCon ips -> do
+ arg_vtys <- repRecConArgs ips
+ rep2 recCName [unC con', unC arg_vtys]
repGadtDataCons :: [Located Name]
- -> HsConDeclDetails GhcRn
+ -> HsConDeclGADTDetails GhcRn
-> LHsType GhcRn
-> MetaM (Core (M TH.Con))
repGadtDataCons cons details res_ty
= do cons' <- mapM lookupLOcc cons -- See Note [Binders and occurrences]
- repConstr details (Just res_ty) cons'
-
--- Invariant:
--- * for plain H98 data constructors second argument is Nothing and third
--- argument is a singleton list
--- * for GADTs data constructors second argument is (Just return_type) and
--- third argument is a non-empty list
-repConstr :: HsConDeclDetails GhcRn
- -> Maybe (LHsType GhcRn)
- -> [Core TH.Name]
- -> MetaM (Core (M TH.Con))
-repConstr (PrefixCon ps) Nothing [con]
- = do arg_tys <- repListM bangTypeTyConName repBangTy (map hsScaledThing ps)
- rep2 normalCName [unC con, unC arg_tys]
-
-repConstr (PrefixCon ps) (Just res_ty) cons
- = do arg_tys <- repListM bangTypeTyConName repBangTy (map hsScaledThing ps)
- res_ty' <- repLTy res_ty
- rep2 gadtCName [ unC (nonEmptyCoreList cons), unC arg_tys, unC res_ty']
-
-repConstr (RecCon ips) resTy cons
- = do args <- concatMapM rep_ip (unLoc ips)
- arg_vtys <- coreListM varBangTypeTyConName args
- case resTy of
- Nothing -> rep2 recCName [unC (head cons), unC arg_vtys]
- Just res_ty -> do
+ case details of
+ PrefixCon ps -> do
+ arg_tys <- repPrefixConArgs ps
res_ty' <- repLTy res_ty
- rep2 recGadtCName [unC (nonEmptyCoreList cons), unC arg_vtys,
+ rep2 gadtCName [ unC (nonEmptyCoreList cons'), unC arg_tys, unC res_ty']
+ InfixCon v _ -> absurd v
+ RecCon ips -> do
+ arg_vtys <- repRecConArgs ips
+ res_ty' <- repLTy res_ty
+ rep2 recGadtCName [unC (nonEmptyCoreList cons'), unC arg_vtys,
unC res_ty']
+-- Desugar the arguments in a PrefixCon.
+repPrefixConArgs :: [HsScaled GhcRn (LHsType GhcRn)]
+ -> MetaM (Core [M TH.BangType])
+repPrefixConArgs ps = repListM bangTypeTyConName repBangTy (map hsScaledThing ps)
+
+-- Desugar the arguments in a RecCon.
+repRecConArgs :: Located [LConDeclField GhcRn]
+ -> MetaM (Core [M TH.VarBangType])
+repRecConArgs ips = do
+ args <- concatMapM rep_ip (unLoc ips)
+ coreListM varBangTypeTyConName args
where
rep_ip (L _ ip) = mapM (rep_one_ip (cd_fld_type ip)) (cd_fld_names ip)
@@ -2632,16 +2636,6 @@ repConstr (RecCon ips) resTy cons
; MkC ty <- repBangTy t
; rep2 varBangTypeName [v,ty] }
-repConstr (InfixCon st1 st2) Nothing [con]
- = do arg1 <- repBangTy (hsScaledThing st1)
- arg2 <- repBangTy (hsScaledThing st2)
- rep2 infixCName [unC arg1, unC con, unC arg2]
-
-repConstr (InfixCon {}) (Just _) _ =
- panic "repConstr: infix GADT constructor should be in a PrefixCon"
-repConstr _ _ _ =
- panic "repConstr: invariant violated"
-
------------ Types -------------------
repTForall :: Core [(M (TH.TyVarBndr TH.Specificity))] -> Core (M TH.Cxt) -> Core (M TH.Type)
=====================================
compiler/GHC/Iface/Ext/Ast.hs
=====================================
@@ -68,6 +68,7 @@ import qualified Data.Map as M
import qualified Data.Set as S
import Data.Data ( Data, Typeable )
import Data.List ( foldl1' )
+import Data.Void
import Control.Monad ( forM_ )
import Control.Monad.Trans.State.Strict
import Control.Monad.Trans.Reader
@@ -578,6 +579,9 @@ class ToHie a where
class HasType a where
getTypeNode :: a -> HieM [HieAST Type]
+instance ToHie Void where
+ toHie = absurd
+
instance (ToHie a) => ToHie [a] where
toHie = concatMapM toHie
@@ -996,8 +1000,10 @@ instance HiePass p => ToHie (PScoped (Located (Pat (GhcPass p)))) where
HieRn -> []
#endif
where
- contextify :: a ~ LPat (GhcPass p) => HsConDetails a (HsRecFields (GhcPass p) a)
- -> HsConDetails (PScoped a) (RContext (HsRecFields (GhcPass p) (PScoped a)))
+ contextify :: a ~ LPat (GhcPass p) => HsConDetails a (HsRecFields (GhcPass p) a) a
+ -> HsConDetails (PScoped a)
+ (RContext (HsRecFields (GhcPass p) (PScoped a)))
+ (PScoped a)
contextify (PrefixCon args) = PrefixCon $ patScopes rsp scope pscope args
contextify (InfixCon a b) = InfixCon a' b'
where [a', b'] = patScopes rsp scope pscope [a,b]
@@ -1314,7 +1320,7 @@ instance HiePass p => ToHie (RScoped (ApplicativeArg (GhcPass p))) where
, toHie $ PS Nothing sc NoScope pat
]
-instance (ToHie arg, ToHie rec) => ToHie (HsConDetails arg rec) where
+instance (ToHie arg, ToHie rec, ToHie inf) => ToHie (HsConDetails arg rec inf) where
toHie (PrefixCon args) = toHie args
toHie (RecCon rec) = toHie rec
toHie (InfixCon a b) = concatM [ toHie a, toHie b]
@@ -1530,7 +1536,7 @@ instance ToHie a => ToHie (HsScaled GhcRn a) where
instance ToHie (Located (ConDecl GhcRn)) where
toHie (L span decl) = concatM $ makeNode decl span : case decl of
ConDeclGADT { con_names = names, con_qvars = exp_vars, con_g_ext = imp_vars
- , con_mb_cxt = ctx, con_args = args, con_res_ty = typ } ->
+ , con_mb_cxt = ctx, con_g_args = args, con_res_ty = typ } ->
[ toHie $ map (C (Decl ConDec $ getRealSpan span)) names
, concatM $ [ bindingsOnly bindings
, toHie $ tvScopes resScope NoScope exp_vars ]
@@ -1545,6 +1551,12 @@ instance ToHie (Located (ConDecl GhcRn)) where
tyScope = mkLScope typ
resScope = ResolvedScopes [ctxScope, rhsScope]
bindings = map (C $ TyVarBind (mkScope (loc exp_vars)) resScope) imp_vars
+
+ condecl_scope :: HsConDeclGADTDetails (GhcPass p) -> Scope
+ condecl_scope args = case args of
+ PrefixCon xs -> scaled_args_scope xs
+ InfixCon v _ -> absurd v
+ RecCon x -> mkLScope x
ConDeclH98 { con_name = name, con_ex_tvs = qvars
, con_mb_cxt = ctx, con_args = dets } ->
[ toHie $ C (Decl ConDec $ getRealSpan span) name
@@ -1556,12 +1568,14 @@ instance ToHie (Located (ConDecl GhcRn)) where
rhsScope = combineScopes ctxScope argsScope
ctxScope = maybe NoScope mkLScope ctx
argsScope = condecl_scope dets
- where condecl_scope :: HsConDeclDetails (GhcPass p) -> Scope
+ condecl_scope :: HsConDeclH98Details (GhcPass p) -> Scope
condecl_scope args = case args of
- PrefixCon xs -> foldr combineScopes NoScope $ map (mkLScope . hsScaledThing) xs
- InfixCon a b -> combineScopes (mkLScope (hsScaledThing a))
- (mkLScope (hsScaledThing b))
- RecCon x -> mkLScope x
+ PrefixCon xs -> scaled_args_scope xs
+ InfixCon a b -> scaled_args_scope [a, b]
+ RecCon x -> mkLScope x
+ where scaled_args_scope :: [HsScaled (GhcPass p) (LHsType (GhcPass p))] -> Scope
+ scaled_args_scope = foldr combineScopes NoScope . map (mkLScope . hsScaledThing)
+
instance ToHie (Located [Located (ConDeclField GhcRn)]) where
toHie (L span decls) = concatM $
=====================================
compiler/GHC/Parser.y
=====================================
@@ -2332,7 +2332,7 @@ forall :: { Located ([AddAnn], Maybe [LHsTyVarBndr Specificity GhcPs]) }
: 'forall' tv_bndrs '.' { sLL $1 $> ([mu AnnForall $1,mj AnnDot $3], Just $2) }
| {- empty -} { noLoc ([], Nothing) }
-constr_stuff :: { Located (Located RdrName, HsConDeclDetails GhcPs) }
+constr_stuff :: { Located (Located RdrName, HsConDeclH98Details GhcPs) }
: infixtype {% fmap (mapLoc (\b -> (dataConBuilderCon b,
dataConBuilderDetails b)))
(runPV $1) }
=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -608,7 +608,7 @@ recordPatSynErr loc pat =
addFatalError $ Error (ErrRecordSyntaxInPatSynDecl pat) [] loc
mkConDeclH98 :: Located RdrName -> Maybe [LHsTyVarBndr Specificity GhcPs]
- -> Maybe (LHsContext GhcPs) -> HsConDeclDetails GhcPs
+ -> Maybe (LHsContext GhcPs) -> HsConDeclH98Details GhcPs
-> ConDecl GhcPs
mkConDeclH98 name mb_forall mb_cxt args
@@ -643,7 +643,7 @@ mkGadtDecl names ty = do
, con_forall = L (getLoc ty) $ isJust mtvs
, con_qvars = fromMaybe [] mtvs
, con_mb_cxt = mcxt
- , con_args = args
+ , con_g_args = args
, con_res_ty = res_ty
, con_doc = Nothing }
, anns )
@@ -1615,7 +1615,7 @@ dataConBuilderCon :: DataConBuilder -> Located RdrName
dataConBuilderCon (PrefixDataConBuilder _ dc) = dc
dataConBuilderCon (InfixDataConBuilder _ dc _) = dc
-dataConBuilderDetails :: DataConBuilder -> HsConDeclDetails GhcPs
+dataConBuilderDetails :: DataConBuilder -> HsConDeclH98Details GhcPs
-- Detect when the record syntax is used:
-- data T = MkT { ... }
=====================================
compiler/GHC/Parser/PostProcess/Haddock.hs
=====================================
@@ -69,6 +69,7 @@ import Control.Monad.Trans.Writer
import Data.Functor.Identity
import Data.Coerce
import qualified Data.Monoid
+import Data.Void
import GHC.Parser.Lexer
import GHC.Parser.Errors
@@ -690,22 +691,22 @@ instance HasHaddock (Located (ConDecl GhcPs)) where
addHaddock (L l_con_decl con_decl) =
extendHdkA l_con_decl $
case con_decl of
- ConDeclGADT { con_g_ext, con_names, con_forall, con_qvars, con_mb_cxt, con_args, con_res_ty } -> do
+ ConDeclGADT { con_g_ext, con_names, con_forall, con_qvars, con_mb_cxt, con_g_args, con_res_ty } -> do
-- discardHasInnerDocs is ok because we don't need this info for GADTs.
con_doc' <- discardHasInnerDocs $ getConDoc (getLoc (head con_names))
- con_args' <-
- case con_args of
+ con_g_args' <-
+ case con_g_args of
PrefixCon ts -> PrefixCon <$> addHaddock ts
RecCon (L l_rec flds) -> do
-- discardHasInnerDocs is ok because we don't need this info for GADTs.
flds' <- traverse (discardHasInnerDocs . addHaddockConDeclField) flds
pure $ RecCon (L l_rec flds')
- InfixCon _ _ -> panic "ConDeclGADT InfixCon"
+ InfixCon v _ -> absurd v
con_res_ty' <- addHaddock con_res_ty
pure $ L l_con_decl $
ConDeclGADT { con_g_ext, con_names, con_forall, con_qvars, con_mb_cxt,
con_doc = con_doc',
- con_args = con_args',
+ con_g_args = con_g_args',
con_res_ty = con_res_ty' }
ConDeclH98 { con_ext, con_name, con_forall, con_ex_tvs, con_mb_cxt, con_args } ->
addConTrailingDoc (srcSpanEnd l_con_decl) $
=====================================
compiler/GHC/Rename/HsType.hs
=====================================
@@ -29,9 +29,9 @@ module GHC.Rename.HsType (
rnImplicitBndrs, bindSigTyVarsFV, bindHsQTyVars,
FreeKiTyVars,
extractHsTyRdrTyVars, extractHsTyRdrTyVarsKindVars,
- extractHsTysRdrTyVars, extractRdrKindSigVars, extractDataDefnKindVars,
+ extractHsTysRdrTyVars, extractRdrKindSigVars,
+ extractConDeclGADTDetailsTyVars, extractDataDefnKindVars,
extractHsTvBndrs, extractHsTyArgRdrKiTyVars,
- extractHsScaledTysRdrTyVars,
forAllOrNothing, nubL
) where
@@ -67,6 +67,7 @@ import GHC.Data.Maybe
import qualified GHC.LanguageExtensions as LangExt
import Data.List ( nubBy, partition )
+import Data.Void
import Control.Monad ( unless, when )
#include "HsVersions.h"
@@ -1747,9 +1748,6 @@ extractHsTyArgRdrKiTyVars args
extractHsTyRdrTyVars :: LHsType GhcPs -> FreeKiTyVars
extractHsTyRdrTyVars ty = extract_lty ty []
-extractHsScaledTysRdrTyVars :: [HsScaled GhcPs (LHsType GhcPs)] -> FreeKiTyVars -> FreeKiTyVars
-extractHsScaledTysRdrTyVars args acc = foldr (\(HsScaled m ty) -> extract_lty ty . extract_hs_arrow m) acc args
-
-- | Extracts the free type/kind variables from the kind signature of a HsType.
-- This is used to implicitly quantify over @k@ in @type T = Nothing :: Maybe k at .
-- The left-to-right order of variables is preserved.
@@ -1787,6 +1785,16 @@ extractRdrKindSigVars (L _ resultSig) = case resultSig of
TyVarSig _ (L _ (KindedTyVar _ _ _ k)) -> extractHsTyRdrTyVars k
_ -> []
+-- | Extracts free type and kind variables from an argument in a GADT
+-- constructor, returning variable occurrences in left-to-right order.
+-- See @Note [Ordering of implicit variables]@.
+extractConDeclGADTDetailsTyVars ::
+ HsConDeclGADTDetails GhcPs -> FreeKiTyVars -> FreeKiTyVars
+extractConDeclGADTDetailsTyVars con_args = case con_args of
+ PrefixCon args -> extract_scaled_ltys args
+ InfixCon v _ -> absurd v
+ RecCon (L _ flds) -> extract_ltys $ map (cd_fld_type . unLoc) $ flds
+
-- | Get type/kind variables mentioned in the kind signature, preserving
-- left-to-right order:
--
@@ -1804,6 +1812,14 @@ extract_lctxt ctxt = extract_ltys (unLoc ctxt)
extract_ltys :: [LHsType GhcPs] -> FreeKiTyVars -> FreeKiTyVars
extract_ltys tys acc = foldr extract_lty acc tys
+extract_scaled_ltys :: [HsScaled GhcPs (LHsType GhcPs)]
+ -> FreeKiTyVars -> FreeKiTyVars
+extract_scaled_ltys args acc = foldr extract_scaled_lty acc args
+
+extract_scaled_lty :: HsScaled GhcPs (LHsType GhcPs)
+ -> FreeKiTyVars -> FreeKiTyVars
+extract_scaled_lty (HsScaled m ty) acc = extract_lty ty $ extract_hs_arrow m acc
+
extract_lty :: LHsType GhcPs -> FreeKiTyVars -> FreeKiTyVars
extract_lty (L _ ty) acc
= case ty of
=====================================
compiler/GHC/Rename/Module.hs
=====================================
@@ -75,6 +75,7 @@ import Data.List.NonEmpty ( NonEmpty(..) )
import Data.Maybe ( isNothing, isJust, fromMaybe, mapMaybe )
import qualified Data.Set as Set ( difference, fromList, toList, null )
import Data.Function ( on )
+import Data.Void
{- | @rnSourceDecl@ "renames" declarations.
It simultaneously performs dependency analysis and precedence parsing.
@@ -2180,7 +2181,7 @@ rnConDecl decl@(ConDeclH98 { con_name = name, con_ex_tvs = ex_tvs
; bindLHsTyVarBndrs ctxt WarnUnusedForalls
Nothing ex_tvs $ \ new_ex_tvs ->
do { (new_context, fvs1) <- rnMbContext ctxt mcxt
- ; (new_args, fvs2) <- rnConDeclDetails (unLoc new_name) ctxt args
+ ; (new_args, fvs2) <- rnConDeclH98Details (unLoc new_name) ctxt args
; let all_fvs = fvs1 `plusFV` fvs2
; traceRn "rnConDecl (ConDeclH98)" (ppr name <+> vcat
[ text "ex_tvs:" <+> ppr ex_tvs
@@ -2197,15 +2198,12 @@ rnConDecl decl@(ConDeclGADT { con_names = names
, con_forall = forall@(L _ explicit_forall)
, con_qvars = explicit_tkvs
, con_mb_cxt = mcxt
- , con_args = args
+ , con_g_args = args
, con_res_ty = res_ty
, con_doc = mb_doc })
= do { mapM_ (addLocM checkConName) names
; new_names <- mapM lookupLocatedTopBndrRn names
- ; let theta = hsConDeclTheta mcxt
- arg_tys = hsConDeclArgTys args
-
-- We must ensure that we extract the free tkvs in left-to-right
-- order of their appearance in the constructor type.
-- That order governs the order the implicitly-quantified type
@@ -2213,9 +2211,9 @@ rnConDecl decl@(ConDeclGADT { con_names = names
-- See #14808.
; implicit_bndrs <- forAllOrNothing explicit_forall
$ extractHsTvBndrs explicit_tkvs
- $ extractHsTysRdrTyVars theta
- $ extractHsScaledTysRdrTyVars arg_tys
- $ extractHsTysRdrTyVars [res_ty] []
+ $ extractHsTysRdrTyVars (hsConDeclTheta mcxt)
+ $ extractConDeclGADTDetailsTyVars args
+ $ extractHsTyRdrTyVars res_ty
; let ctxt = ConDeclCtx new_names
@@ -2223,7 +2221,7 @@ rnConDecl decl@(ConDeclGADT { con_names = names
bindLHsTyVarBndrs ctxt WarnUnusedForalls
Nothing explicit_tkvs $ \ explicit_tkvs ->
do { (new_cxt, fvs1) <- rnMbContext ctxt mcxt
- ; (new_args, fvs2) <- rnConDeclDetails (unLoc (head new_names)) ctxt args
+ ; (new_args, fvs2) <- rnConDeclGADTDetails (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
@@ -2238,7 +2236,7 @@ rnConDecl decl@(ConDeclGADT { con_names = names
(ppr names $$ ppr implicit_tkvs $$ ppr explicit_tkvs)
; return (decl { con_g_ext = implicit_tkvs, con_names = new_names
, con_qvars = explicit_tkvs, con_mb_cxt = new_cxt
- , con_args = new_args, con_res_ty = new_res_ty
+ , con_g_args = new_args, con_res_ty = new_res_ty
, con_doc = mb_doc
, con_forall = forall }, -- Remove when #18311 is fixed
all_fvs) } }
@@ -2249,22 +2247,36 @@ rnMbContext _ Nothing = return (Nothing, emptyFVs)
rnMbContext doc (Just cxt) = do { (ctx',fvs) <- rnContext doc cxt
; return (Just ctx',fvs) }
-rnConDeclDetails
- :: Name
+rnConDeclH98Details ::
+ Name
+ -> HsDocContext
+ -> HsConDeclH98Details GhcPs
+ -> RnM (HsConDeclH98Details GhcRn, FreeVars)
+rnConDeclH98Details = rnConDeclDetails rnScaledLHsType
+
+rnConDeclGADTDetails ::
+ Name
+ -> HsDocContext
+ -> HsConDeclGADTDetails GhcPs
+ -> RnM (HsConDeclGADTDetails GhcRn, FreeVars)
+rnConDeclGADTDetails = rnConDeclDetails (\_ -> absurd)
+
+rnConDeclDetails ::
+ (HsDocContext -> infPs -> RnM (infRn, FreeVars))
+ -> Name
-> HsDocContext
- -> HsConDetails (HsScaled GhcPs (LHsType GhcPs)) (Located [LConDeclField GhcPs])
- -> RnM ((HsConDetails (HsScaled GhcRn (LHsType GhcRn))) (Located [LConDeclField GhcRn]),
- FreeVars)
-rnConDeclDetails _ doc (PrefixCon tys)
+ -> HsConDeclDetails GhcPs infPs
+ -> RnM (HsConDeclDetails GhcRn infRn, FreeVars)
+rnConDeclDetails _ _ doc (PrefixCon tys)
= do { (new_tys, fvs) <- mapFvRn (rnScaledLHsType doc) tys
; return (PrefixCon new_tys, fvs) }
-rnConDeclDetails _ doc (InfixCon ty1 ty2)
- = do { (new_ty1, fvs1) <- rnScaledLHsType doc ty1
- ; (new_ty2, fvs2) <- rnScaledLHsType doc ty2
+rnConDeclDetails rnInf _ doc (InfixCon ty1 ty2)
+ = do { (new_ty1, fvs1) <- rnInf doc ty1
+ ; (new_ty2, fvs2) <- rnInf doc ty2
; return (InfixCon new_ty1 new_ty2, fvs1 `plusFV` fvs2) }
-rnConDeclDetails con doc (RecCon (L l fields))
+rnConDeclDetails _ con doc (RecCon (L l fields))
= do { fls <- lookupConstructorFields con
; (new_fields, fvs) <- rnConDeclFields doc fls fields
-- No need to check for duplicate fields
=====================================
compiler/GHC/Rename/Names.hs
=====================================
@@ -759,7 +759,7 @@ getLocalNonValBinders fixity_env
= [( find_con_name rdr
, concatMap find_con_decl_flds (unLoc cdflds) )]
find_con_flds (L _ (ConDeclGADT { con_names = rdrs
- , con_args = RecCon flds }))
+ , con_g_args = RecCon flds }))
= [ ( find_con_name rdr
, concatMap find_con_decl_flds (unLoc flds))
| L _ rdr <- rdrs ]
=====================================
compiler/GHC/Tc/TyCl.hs
=====================================
@@ -81,12 +81,14 @@ import GHC.Types.Basic
import qualified GHC.LanguageExtensions as LangExt
import Control.Monad
+import Data.Foldable
import Data.Function ( on )
import Data.Functor.Identity
import Data.List
import Data.List.NonEmpty ( NonEmpty(..) )
import qualified Data.Set as Set
import Data.Tuple( swap )
+import Data.Void
{-
************************************************************************
@@ -1563,18 +1565,33 @@ kcTyClDecl (FamDecl _ (FamilyDecl { fdInfo = fd_info })) fam_tc
-------------------
--- Type check the types of the arguments to a data constructor.
+-- Kind-check the type of an argument to a data constructor.
-- This includes doing kind unification if the type is a newtype.
-- See Note [Implementation of UnliftedNewtypes] for why we need
--- the first two arguments.
-kcConArgTys :: NewOrData -> Kind -> [HsScaled GhcRn (LHsType GhcRn)] -> TcM ()
-kcConArgTys new_or_data res_kind arg_tys = do
- { let exp_kind = getArgExpKind new_or_data res_kind
- ; forM_ arg_tys (\(HsScaled mult ty) -> do _ <- tcCheckLHsType (getBangType ty) exp_kind
- tcMult mult)
-
+-- the ContextKind argument.
+kcConArg :: ContextKind -> HsScaled GhcRn (LHsType GhcRn) -> TcM ()
+kcConArg exp_kind (HsScaled mult ty) = do
+ _ <- tcCheckLHsType (getBangType ty) exp_kind
+ _ <- tcMult mult
+ pure ()
-- See Note [Implementation of UnliftedNewtypes], STEP 2
- }
+
+-- Kind-check the types of arguments to a Haskell98 data constructor.
+kcConH98Args :: ContextKind -> HsConDeclH98Details GhcRn -> TcM ()
+kcConH98Args = kcConArgs kcConArg
+
+-- Kind-check the types of arguments to a GADT data constructor.
+kcConGADTArgs :: ContextKind -> HsConDeclGADTDetails GhcRn -> TcM ()
+kcConGADTArgs = kcConArgs (\_ -> absurd)
+
+-- Kind-check the types of argument to a data constructor.
+kcConArgs :: (ContextKind -> infRn -> TcM ())
+ -> ContextKind -> HsConDeclDetails GhcRn infRn -> TcM ()
+kcConArgs kc_inf exp_kind con_args = case con_args of
+ PrefixCon tys -> traverse_ (kcConArg exp_kind) tys
+ InfixCon ty1 ty2 -> traverse_ (kc_inf exp_kind) [ty1, ty2]
+ RecCon (L _ flds) -> traverse_ (kcConArg exp_kind) $
+ map (hsLinear . cd_fld_type . unLoc) flds
kcConDecls :: NewOrData
-> Kind -- The result kind signature
@@ -1604,14 +1621,14 @@ kcConDecl new_or_data res_kind (ConDeclH98
discardResult $
bindExplicitTKBndrs_Tv ex_tvs $
do { _ <- tcHsMbContext ex_ctxt
- ; kcConArgTys new_or_data res_kind (hsConDeclArgTys args)
+ ; kcConH98Args (getArgExpKind new_or_data res_kind) args
-- We don't need to check the telescope here,
-- because that's done in tcConDecl
}
kcConDecl new_or_data res_kind (ConDeclGADT
{ con_names = names, con_qvars = explicit_tkv_nms, con_mb_cxt = cxt
- , con_args = args, con_res_ty = res_ty, con_g_ext = implicit_tkv_nms })
+ , con_g_args = args, con_res_ty = res_ty, con_g_ext = implicit_tkv_nms })
= -- Even though the GADT-style data constructor's type is closed,
-- we must still kind-check the type, because that may influence
-- the inferred kind of the /type/ constructor. Example:
@@ -1625,7 +1642,7 @@ kcConDecl new_or_data res_kind (ConDeclGADT
bindExplicitTKBndrs_Tv explicit_tkv_nms $
-- Why "_Tv"? See Note [Kind-checking for GADTs]
do { _ <- tcHsMbContext cxt
- ; kcConArgTys new_or_data res_kind (hsConDeclArgTys args)
+ ; kcConGADTArgs (getArgExpKind new_or_data res_kind) args
; _ <- tcHsOpenType res_ty
; return () }
@@ -3196,7 +3213,7 @@ tcConDecl rep_tycon tag_map tmpl_bndrs res_kind res_tmpl new_or_data
bindExplicitTKBndrs_Skol explicit_tkv_nms $
do { ctxt <- tcHsMbContext hs_ctxt
; let exp_kind = getArgExpKind new_or_data res_kind
- ; btys <- tcConArgs exp_kind hs_args
+ ; btys <- tcConH98Args exp_kind hs_args
; field_lbls <- lookupConstructorFields name
; let (arg_tys, stricts) = unzip btys
; return (ctxt, arg_tys, field_lbls, stricts)
@@ -3266,7 +3283,7 @@ tcConDecl rep_tycon tag_map tmpl_bndrs _res_kind res_tmpl new_or_data
(ConDeclGADT { con_g_ext = implicit_tkv_nms
, con_names = names
, con_qvars = explicit_tkv_nms
- , con_mb_cxt = cxt, con_args = hs_args
+ , con_mb_cxt = cxt, con_g_args = hs_args
, con_res_ty = hs_res_ty })
= addErrCtxt (dataConCtxtName names) $
do { traceTc "tcConDecl 1 gadt" (ppr names)
@@ -3283,7 +3300,7 @@ tcConDecl rep_tycon tag_map tmpl_bndrs _res_kind res_tmpl new_or_data
-- See Note [Datatype return kinds]
; let exp_kind = getArgExpKind new_or_data res_kind
- ; btys <- tcConArgs exp_kind hs_args
+ ; btys <- tcConGADTArgs exp_kind hs_args
; let (arg_tys, stricts) = unzip btys
; field_lbls <- lookupConstructorFields name
; return (ctxt, arg_tys, res_ty, field_lbls, stricts)
@@ -3362,19 +3379,20 @@ getArgExpKind NewType res_ki = TheKind res_ki
getArgExpKind DataType _ = OpenKind
tcConIsInfixH98 :: Name
- -> HsConDetails a b
+ -> HsConDeclH98Details GhcRn
-> TcM Bool
tcConIsInfixH98 _ details
= case details of
InfixCon {} -> return True
- _ -> return False
+ RecCon{} -> return False
+ PrefixCon{} -> return False
tcConIsInfixGADT :: Name
- -> HsConDetails (HsScaled GhcRn (LHsType GhcRn)) r
+ -> HsConDeclGADTDetails GhcRn
-> TcM Bool
tcConIsInfixGADT con details
= case details of
- InfixCon {} -> return True
+ InfixCon v _ -> absurd v
RecCon {} -> return False
PrefixCon arg_tys -- See Note [Infix GADT constructors]
| isSymOcc (getOccName con)
@@ -3383,18 +3401,31 @@ tcConIsInfixGADT con details
; return (con `elemNameEnv` fix_env) }
| otherwise -> return False
-tcConArgs :: ContextKind -- expected kind of arguments
+tcConH98Args :: ContextKind -- expected kind of arguments
+ -- always OpenKind for datatypes, but unlifted newtypes
+ -- might have a specific kind
+ -> HsConDeclH98Details GhcRn
+ -> TcM [(Scaled TcType, HsSrcBang)]
+tcConH98Args = tcConArgs tcConArg
+
+tcConGADTArgs :: ContextKind -- expected kind of arguments
+ -- always OpenKind for datatypes, but unlifted newtypes
+ -- might have a specific kind
+ -> HsConDeclGADTDetails GhcRn
+ -> TcM [(Scaled TcType, HsSrcBang)]
+tcConGADTArgs = tcConArgs (\_ -> absurd)
+
+tcConArgs :: (ContextKind -> infRn -> TcM (Scaled TcType, HsSrcBang))
+ -> ContextKind -- expected kind of arguments
-- always OpenKind for datatypes, but unlifted newtypes
-- might have a specific kind
- -> HsConDeclDetails GhcRn
+ -> HsConDeclDetails GhcRn infRn
-> TcM [(Scaled TcType, HsSrcBang)]
-tcConArgs exp_kind (PrefixCon btys)
+tcConArgs _ exp_kind (PrefixCon btys)
= mapM (tcConArg exp_kind) btys
-tcConArgs exp_kind (InfixCon bty1 bty2)
- = do { bty1' <- tcConArg exp_kind bty1
- ; bty2' <- tcConArg exp_kind bty2
- ; return [bty1', bty2'] }
-tcConArgs exp_kind (RecCon fields)
+tcConArgs tc_inf exp_kind (InfixCon bty1 bty2)
+ = mapM (tc_inf exp_kind) [bty1, bty2]
+tcConArgs _ exp_kind (RecCon fields)
= mapM (tcConArg exp_kind) btys
where
-- We need a one-to-one mapping from field_names to btys
=====================================
compiler/GHC/ThToHs.hs
=====================================
@@ -630,7 +630,7 @@ cvtConstr (RecGadtC c varstrtys ty)
; rec_flds <- mapM cvt_id_arg varstrtys
; returnL $ mk_gadt_decl c' (RecCon $ noLoc rec_flds) ty' }
-mk_gadt_decl :: [Located RdrName] -> HsConDeclDetails GhcPs -> LHsType GhcPs
+mk_gadt_decl :: [Located RdrName] -> HsConDeclGADTDetails GhcPs -> LHsType GhcPs
-> ConDecl GhcPs
mk_gadt_decl names args res_ty
= ConDeclGADT { con_g_ext = noExtField
@@ -638,7 +638,7 @@ mk_gadt_decl names args res_ty
, con_forall = noLoc False
, con_qvars = []
, con_mb_cxt = Nothing
- , con_args = args
+ , con_g_args = args
, con_res_ty = res_ty
, con_doc = Nothing }
=====================================
docs/users_guide/9.2.1-notes.rst
=====================================
@@ -37,14 +37,63 @@ Compiler
- ``Void#`` is now a type synonym for the unboxed tuple ``(# #)``.
Code using ``Void#`` now has to enable :extension:`UnboxedTuples`.
+``ghc`` library
+~~~~~~~~~~~~~~~
+
+- The ``con_args`` field of ``ConDeclGADT`` has been renamed to ``con_g_args``.
+ This is because the type of ``con_g_args`` is now different from the type of
+ the ``con_args`` field in ``ConDeclH98``: ::
+
+ data ConDecl pass
+ = ConDeclGADT
+ { ...
+ , con_g_args :: HsConDeclGADTDetails pass -- ^ Arguments; never InfixCon
+ , ...
+ }
+
+ | ConDeclH98
+ { ...
+ , con_args :: HsConDeclH98Details pass -- ^ Arguments; can be InfixCon
+ , ...
+ }
+
+ Where: ::
+
+ -- New type synonym introduced in GHC 9.2; equivalent to `HsConDeclDetails`
+ -- in previous versions of GHC
+ type HsConDeclH98Details pass
+ = HsConDeclDetails pass (HsScaled pass (LBangType pass))
+
+ -- New type synonym introduced in GHC 9.2
+ type HsConDeclGADTDetails pass
+ = HsConDeclDetails pass Void
+
+ -- The `inf` type parameter is new in GHC 9.2
+ type HsConDeclDetails pass inf
+ = HsConDetails (HsScaled pass (LBangType pass))
+ (XRec pass [LConDeclField pass])
+ inf
+
+ -- The `inf` type parameter is new in GHC 9.2
+ data HsConDetails arg rec inf
+ = PrefixCon [arg] -- C p1 p2 p3
+ | RecCon rec -- C { x = p1, y = p2 }
+ | InfixCon inf inf -- p1 `C` p2
+
+ The use of ``Void`` in ``HsConDeclGADTDetails`` reflects the fact that GADT
+ constructors cannot use infix syntax like Haskell98-style constructors can.
+
+ As a result of all this, the ``con_args`` field is now partial, so using
+ ``con_args`` as a top-level field selector is discouraged.
+
``base`` library
~~~~~~~~~~~~~~~~
-- It's possible now to promote the ``Natural`` type: ::
-
+- It's possible now to promote the ``Natural`` type: ::
+
data Coordinate = Mk2D Natural Natural
type MyCoordinate = Mk2D 1 10
-
+
The separate kind ``Nat`` is removed and now it is just a type synonym for
``Natural``. As a consequence, one must enable ``TypeSynonymInstances``
in order to define instances for ``Nat``.
=====================================
utils/haddock
=====================================
@@ -1 +1 @@
-Subproject commit f7d9e0bb987ca31c3b15cbe63198dafbeee3a395
+Subproject commit e55b11af180271e4fdc3a548857342e182deec5c
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/037ced558dc32302972b8ca8e06aac0a90851528
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/037ced558dc32302972b8ca8e06aac0a90851528
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/20201017/4001c4e1/attachment-0001.html>
More information about the ghc-commits
mailing list