diff options
| author | Ryan Scott <ryan.gl.scott@gmail.com> | 2017-08-29 12:38:54 -0400 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2017-08-29 12:39:18 -0400 |
| commit | 895a7650a038131f3043f882c558c627abe9a61e (patch) | |
| tree | 69a1948f4303d5801ac21884c68a61556e285268 /compiler/deSugar | |
| parent | 5266ab9059dffa741b172636f50f1fbfd491dbb4 (diff) | |
| download | haskell-895a7650a038131f3043f882c558c627abe9a61e.tar.gz | |
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
Diffstat (limited to 'compiler/deSugar')
| -rw-r--r-- | compiler/deSugar/DsMeta.hs | 24 |
1 files changed, 13 insertions, 11 deletions
diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs index b78e366a4a..5e630e56ac 100644 --- a/compiler/deSugar/DsMeta.hs +++ b/compiler/deSugar/DsMeta.hs @@ -357,7 +357,7 @@ repFamilyDecl decl@(L loc (FamilyDecl { fdInfo = info, ClosedTypeFamily Nothing -> notHandled "abstract closed type family" (ppr decl) ClosedTypeFamily (Just eqns) -> - do { eqns1 <- mapM repTyFamEqn eqns + do { eqns1 <- mapM (repTyFamEqn . unLoc) eqns ; eqns2 <- coreList tySynEqnQTyConName eqns1 ; result <- repFamilyResultSig resultSig ; inj <- repInjectivityAnn injectivity @@ -412,9 +412,9 @@ repAssocTyFamDefaults = mapM rep_deflt where -- very like repTyFamEqn, but different in the details rep_deflt :: LTyFamDefltEqn GhcRn -> DsM (Core TH.DecQ) - rep_deflt (L _ (TyFamEqn { tfe_tycon = tc - , tfe_pats = bndrs - , tfe_rhs = rhs })) + rep_deflt (L _ (FamEqn { feqn_tycon = tc + , feqn_pats = bndrs + , feqn_rhs = rhs })) = addTyClTyVarBinds bndrs $ \ _ -> do { tc1 <- lookupLOcc tc ; tys1 <- repLTys (hsLTyVarBndrsToTypes bndrs) @@ -495,10 +495,10 @@ repTyFamInstD decl@(TyFamInstDecl { tfid_eqn = eqn }) ; eqn1 <- repTyFamEqn eqn ; repTySynInst tc eqn1 } -repTyFamEqn :: LTyFamInstEqn GhcRn -> DsM (Core TH.TySynEqnQ) -repTyFamEqn (L _ (TyFamEqn { tfe_pats = HsIB { hsib_body = tys - , hsib_vars = var_names } - , tfe_rhs = rhs })) +repTyFamEqn :: TyFamInstEqn GhcRn -> DsM (Core TH.TySynEqnQ) +repTyFamEqn (HsIB { hsib_vars = var_names + , hsib_body = FamEqn { feqn_pats = tys + , feqn_rhs = rhs }}) = do { let hs_tvs = HsQTvs { hsq_implicit = var_names , hsq_explicit = [] , hsq_dependent = emptyNameSet } -- Yuk @@ -509,9 +509,11 @@ repTyFamEqn (L _ (TyFamEqn { tfe_pats = HsIB { hsib_body = tys ; repTySynEqn tys2 rhs1 } } repDataFamInstD :: DataFamInstDecl GhcRn -> DsM (Core TH.DecQ) -repDataFamInstD (DataFamInstDecl { dfid_tycon = tc_name - , dfid_pats = HsIB { hsib_body = tys, hsib_vars = var_names } - , dfid_defn = defn }) +repDataFamInstD (DataFamInstDecl { dfid_eqn = + (HsIB { hsib_vars = var_names + , hsib_body = FamEqn { feqn_tycon = tc_name + , feqn_pats = tys + , feqn_rhs = defn }})}) = do { tc <- lookupLOcc tc_name -- See note [Binders and occurrences] ; let hs_tvs = HsQTvs { hsq_implicit = var_names , hsq_explicit = [] |