From 895a7650a038131f3043f882c558c627abe9a61e Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Tue, 29 Aug 2017 12:38:54 -0400 Subject: Refactor type family instance abstract syntax declarations This implements @simonpj's suggested refactoring of the abstract syntax for type/data family instances (from https://ghc.haskell.org/trac/ghc/ticket/14131#comment:9). This combines the previously separate `TyFamEqn` and `DataFamInstDecl` types into a single `FamEqn` datatype. This also factors the `HsImplicitBndrs` out of `HsTyPats` in favor of putting them just outside of `FamEqn` (as opposed to before, where all of the implicit binders were embedded inside of `TyFamEqn`/`DataFamInstDecl`). Finally, along the way I noticed that `dfid_fvs` and `tfid_fvs` were completely unused, so I removed them. Aside from some changes in parser test output, there is no change in behavior. Requires a Haddock submodule commit from my fork (at https://github.com/RyanGlScott/haddock/commit/815d2deb9c0222c916becccf84 64b740c26255fd) Test Plan: ./validate Reviewers: simonpj, austin, goldfire, bgamari, alanz Reviewed By: bgamari Subscribers: mpickering, goldfire, rwbarton, thomie, simonpj GHC Trac Issues: #14131 Differential Revision: https://phabricator.haskell.org/D3881 --- compiler/parser/RdrHsSyn.hs | 40 ++++++++++++++++++++-------------------- 1 file changed, 20 insertions(+), 20 deletions(-) (limited to 'compiler/parser/RdrHsSyn.hs') diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs index ecfae760a8..41d8a4a339 100644 --- a/compiler/parser/RdrHsSyn.hs +++ b/compiler/parser/RdrHsSyn.hs @@ -159,14 +159,14 @@ mkATDefault :: LTyFamInstDecl GhcPs -- -- We use the Either monad because this also called -- from Convert.hs -mkATDefault (L loc (TyFamInstDecl { tfid_eqn = L _ e })) - | TyFamEqn { tfe_tycon = tc, tfe_pats = pats, tfe_fixity = fixity - , tfe_rhs = rhs } <- e - = do { tvs <- checkTyVars (text "default") equalsDots tc (hsib_body pats) - ; return (L loc (TyFamEqn { tfe_tycon = tc - , tfe_pats = tvs - , tfe_fixity = fixity - , tfe_rhs = rhs })) } +mkATDefault (L loc (TyFamInstDecl { tfid_eqn = HsIB { hsib_body = e }})) + | FamEqn { feqn_tycon = tc, feqn_pats = pats, feqn_fixity = fixity + , feqn_rhs = rhs } <- e + = do { tvs <- checkTyVars (text "default") equalsDots tc pats + ; return (L loc (FamEqn { feqn_tycon = tc + , feqn_pats = tvs + , feqn_fixity = fixity + , feqn_rhs = rhs })) } mkTyData :: SrcSpan -> NewOrData @@ -221,10 +221,11 @@ mkTyFamInstEqn :: LHsType GhcPs -> P (TyFamInstEqn GhcPs,[AddAnn]) mkTyFamInstEqn lhs rhs = do { (tc, tparams, fixity, ann) <- checkTyClHdr False lhs - ; return (TyFamEqn { tfe_tycon = tc - , tfe_pats = mkHsImplicitBndrs tparams - , tfe_fixity = fixity - , tfe_rhs = rhs }, + ; return (mkHsImplicitBndrs + (FamEqn { feqn_tycon = tc + , feqn_pats = tparams + , feqn_fixity = fixity + , feqn_rhs = rhs }), ann) } mkDataFamInst :: SrcSpan @@ -239,18 +240,17 @@ mkDataFamInst loc new_or_data cType (L _ (mcxt, tycl_hdr)) ksig data_cons maybe_ = do { (tc, tparams, fixity, ann) <- checkTyClHdr False tycl_hdr ; mapM_ (\a -> a 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 ( - DataFamInstDecl { dfid_tycon = tc - , dfid_pats = mkHsImplicitBndrs tparams - , dfid_fixity = fixity - , dfid_defn = defn, dfid_fvs = placeHolderNames }))) } + ; return (L loc (DataFamInstD (DataFamInstDecl (mkHsImplicitBndrs + (FamEqn { feqn_tycon = tc + , feqn_pats = tparams + , feqn_fixity = fixity + , feqn_rhs = defn }))))) } mkTyFamInst :: SrcSpan - -> LTyFamInstEqn GhcPs + -> TyFamInstEqn GhcPs -> P (LInstDecl GhcPs) mkTyFamInst loc eqn - = return (L loc (TyFamInstD (TyFamInstDecl { tfid_eqn = eqn - , tfid_fvs = placeHolderNames }))) + = return (L loc (TyFamInstD (TyFamInstDecl eqn))) mkFamDecl :: SrcSpan -> FamilyInfo GhcPs -- cgit v1.2.1