diff options
| author | Ben Gamari <bgamari.foss@gmail.com> | 2015-12-14 15:01:12 +0100 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2015-12-14 15:34:03 +0100 |
| commit | 04ab55d9a6fe311b7cb544211738caca6c00c720 (patch) | |
| tree | f1e48296c1cbfd94eb7cafd935f2c2baf570eb61 /compiler/deSugar/DsMeta.hs | |
| parent | 65920c9e6a17094c3a0abbdbed5ab01f8524850e (diff) | |
| download | haskell-04ab55d9a6fe311b7cb544211738caca6c00c720.tar.gz | |
Use Cxt for deriving clauses in TH (#10819)
Summary:
Deriving clauses in the TH representations of data, newtype, data
instance, and newtype instance declarations previously were just [Name],
which didn't allow for more complex derived classes, eg. multi-parameter
typeclasses.
This switches out [Name] for Cxt, representing the derived classes as
types instead of names.
Test Plan: validate
Reviewers: goldfire, spinda, austin
Reviewed By: goldfire, austin
Subscribers: thomie
Differential Revision: https://phabricator.haskell.org/D1202
GHC Trac Issues: #10819
Diffstat (limited to 'compiler/deSugar/DsMeta.hs')
| -rw-r--r-- | compiler/deSugar/DsMeta.hs | 28 |
1 files changed, 14 insertions, 14 deletions
diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs index ab8c227e5c..30eb388137 100644 --- a/compiler/deSugar/DsMeta.hs +++ b/compiler/deSugar/DsMeta.hs @@ -763,19 +763,19 @@ repBangTy ty = do -- Deriving clause ------------------------------------------------------- -repDerivs :: HsDeriving Name -> DsM (Core [TH.Name]) -repDerivs Nothing = coreList nameTyConName [] -repDerivs (Just (L _ ctxt)) - = repList nameTyConName (rep_deriv . hsSigType) ctxt +repDerivs :: HsDeriving Name -> DsM (Core TH.CxtQ) +repDerivs deriv = do + let clauses + | Nothing <- deriv = [] + | Just (L _ ctxt) <- deriv = ctxt + tys <- repList typeQTyConName + (rep_deriv . hsSigType) + clauses + :: DsM (Core [TH.PredQ]) + repCtxt tys where - rep_deriv :: LHsType Name -> DsM (Core TH.Name) - -- Deriving clauses must have the simple H98 form - rep_deriv ty - | Just (L _ cls, []) <- hsTyGetAppHead_maybe ty - = lookupOcc cls - | otherwise - = notHandled "Non-H98 deriving clause" (ppr ty) - + rep_deriv :: LHsType Name -> DsM (Core TH.TypeQ) + rep_deriv (L _ ty) = repTy ty ------------------------------------------------------- -- Signatures in a class decl, or a group of bindings @@ -1937,7 +1937,7 @@ repFun (MkC nm) (MkC b) = rep2 funDName [nm, b] repData :: Core TH.CxtQ -> Core TH.Name -> Core [TH.TyVarBndr] -> Maybe (Core [TH.TypeQ]) - -> Core [TH.ConQ] -> Core [TH.Name] -> DsM (Core TH.DecQ) + -> Core [TH.ConQ] -> Core TH.CxtQ -> DsM (Core TH.DecQ) repData (MkC cxt) (MkC nm) (MkC tvs) Nothing (MkC cons) (MkC derivs) = rep2 dataDName [cxt, nm, tvs, cons, derivs] repData (MkC cxt) (MkC nm) (MkC _) (Just (MkC tys)) (MkC cons) (MkC derivs) @@ -1945,7 +1945,7 @@ repData (MkC cxt) (MkC nm) (MkC _) (Just (MkC tys)) (MkC cons) (MkC derivs) repNewtype :: Core TH.CxtQ -> Core TH.Name -> Core [TH.TyVarBndr] -> Maybe (Core [TH.TypeQ]) - -> Core TH.ConQ -> Core [TH.Name] -> DsM (Core TH.DecQ) + -> Core TH.ConQ -> Core TH.CxtQ -> DsM (Core TH.DecQ) repNewtype (MkC cxt) (MkC nm) (MkC tvs) Nothing (MkC con) (MkC derivs) = rep2 newtypeDName [cxt, nm, tvs, con, derivs] repNewtype (MkC cxt) (MkC nm) (MkC _) (Just (MkC tys)) (MkC con) (MkC derivs) |