diff options
Diffstat (limited to 'compiler/GHC/Parser/PostProcess.hs')
| -rw-r--r-- | compiler/GHC/Parser/PostProcess.hs | 36 |
1 files changed, 17 insertions, 19 deletions
diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs index 8e85c9493e..94b1ef188a 100644 --- a/compiler/GHC/Parser/PostProcess.hs +++ b/compiler/GHC/Parser/PostProcess.hs @@ -24,7 +24,7 @@ module GHC.Parser.PostProcess ( mkTySynonym, mkTyFamInstEqn, mkStandaloneKindSig, mkTyFamInst, - mkFamDecl, mkLHsSigType, + mkFamDecl, mkInlinePragma, mkPatSynMatchGroup, mkRecConstrOrUpdate, -- HsExp -> [HsFieldUpdate] -> P HsExp @@ -250,12 +250,12 @@ mkTySynonym loc lhs rhs mkStandaloneKindSig :: SrcSpan -> Located [Located RdrName] -- LHS - -> LHsKind GhcPs -- RHS + -> LHsSigType GhcPs -- RHS -> P (LStandaloneKindSig GhcPs) mkStandaloneKindSig loc lhs rhs = do { vs <- mapM check_lhs_name (unLoc lhs) ; v <- check_singular_lhs (reverse vs) - ; return $ L loc $ StandaloneKindSig noExtField v (mkLHsSigType rhs) } + ; return $ L loc $ StandaloneKindSig noExtField v rhs } where check_lhs_name v@(unLoc->name) = if isUnqual name && isTcOcc (rdrNameOcc name) @@ -267,25 +267,24 @@ mkStandaloneKindSig loc lhs rhs = [v] -> return v _ -> addFatalError $ Error (ErrMultipleNamesInStandaloneKindSignature vs) [] (getLoc lhs) -mkTyFamInstEqn :: Maybe [LHsTyVarBndr () GhcPs] +mkTyFamInstEqn :: HsOuterFamEqnTyVarBndrs GhcPs -> LHsType GhcPs -> LHsType GhcPs -> P (TyFamInstEqn GhcPs,[AddAnn]) mkTyFamInstEqn bndrs lhs rhs = do { (tc, tparams, fixity, ann) <- checkTyClHdr False lhs - ; return (mkHsImplicitBndrs - (FamEqn { feqn_ext = noExtField - , feqn_tycon = tc - , feqn_bndrs = bndrs - , feqn_pats = tparams - , feqn_fixity = fixity - , feqn_rhs = rhs }), + ; return (FamEqn { feqn_ext = noExtField + , feqn_tycon = tc + , feqn_bndrs = bndrs + , feqn_pats = tparams + , feqn_fixity = fixity + , feqn_rhs = rhs }, ann) } mkDataFamInst :: SrcSpan -> NewOrData -> Maybe (Located CType) - -> (Maybe ( LHsContext GhcPs), Maybe [LHsTyVarBndr () GhcPs] + -> (Maybe ( LHsContext GhcPs), HsOuterFamEqnTyVarBndrs GhcPs , LHsType GhcPs) -> Maybe (LHsKind GhcPs) -> [LConDecl GhcPs] @@ -296,13 +295,13 @@ mkDataFamInst loc new_or_data cType (mcxt, bndrs, tycl_hdr) = do { (tc, tparams, fixity, ann) <- checkTyClHdr False tycl_hdr ; addAnnsAt loc ann -- Add any API Annotations to the top SrcSpan ; defn <- mkDataDefn new_or_data cType mcxt ksig data_cons maybe_deriv - ; return (L loc (DataFamInstD noExtField (DataFamInstDecl (mkHsImplicitBndrs + ; return (L loc (DataFamInstD noExtField (DataFamInstDecl (FamEqn { feqn_ext = noExtField , feqn_tycon = tc , feqn_bndrs = bndrs , feqn_pats = tparams , feqn_fixity = fixity - , feqn_rhs = defn }))))) } + , feqn_rhs = defn })))) } mkTyFamInst :: SrcSpan -> TyFamInstEqn GhcPs @@ -631,7 +630,7 @@ mkConDeclH98 name mb_forall mb_cxt args -- records whether this is a prefix or record GADT constructor. See -- Note [GADT abstract syntax] in "GHC.Hs.Decls" for more details. mkGadtDecl :: [Located RdrName] - -> LHsType GhcPs + -> LHsSigType GhcPs -> P (ConDecl GhcPs, [AddAnn]) mkGadtDecl names ty = do let (args, res_ty, anns) @@ -643,15 +642,14 @@ mkGadtDecl names ty = do pure ( ConDeclGADT { con_g_ext = noExtField , con_names = names - , con_forall = L (getLoc ty) $ isJust mtvs - , con_qvars = fromMaybe [] mtvs + , con_bndrs = L (getLoc ty) outer_bndrs , con_mb_cxt = mcxt , con_g_args = args , con_res_ty = res_ty , con_doc = Nothing } , anns ) where - (mtvs, mcxt, body_ty) = splitLHsGadtTy ty + (outer_bndrs, mcxt, body_ty) = splitLHsGadtTy ty setRdrNameSpace :: RdrName -> NameSpace -> RdrName -- ^ This rather gruesome function is used mainly by the parser. @@ -1480,7 +1478,7 @@ instance DisambECP (HsExpr GhcPs) where mkHsLitPV (L l a) = return $ L l (HsLit noExtField a) mkHsOverLitPV (L l a) = return $ L l (HsOverLit noExtField a) mkHsWildCardPV l = return $ L l hsHoleExpr - mkHsTySigPV l a sig = return $ L l (ExprWithTySig noExtField a (mkLHsSigWcType sig)) + mkHsTySigPV l a sig = return $ L l (ExprWithTySig noExtField a (hsTypeToHsSigWcType sig)) mkHsExplicitListPV l xs = return $ L l (ExplicitList noExtField Nothing xs) mkHsSplicePV sp = return $ mapLoc (HsSpliceE noExtField) sp mkHsRecordPV l lrec a (fbinds, ddLoc) = do |