diff options
Diffstat (limited to 'compiler/hsSyn/Convert.hs')
| -rw-r--r-- | compiler/hsSyn/Convert.hs | 18 |
1 files changed, 11 insertions, 7 deletions
diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs index 9063d1f773..71cf5a6c34 100644 --- a/compiler/hsSyn/Convert.hs +++ b/compiler/hsSyn/Convert.hs @@ -359,11 +359,12 @@ cvtDec (TH.RoleAnnotD tc roles) cvtDec (TH.StandaloneDerivD ds cxt ty) = do { cxt' <- cvtContext cxt + ; ds' <- traverse cvtDerivStrategy ds ; L loc ty' <- cvtType ty ; let inst_ty' = mkHsQualTy cxt loc cxt' $ L loc ty' ; returnJustL $ DerivD noExt $ DerivDecl { deriv_ext =noExt - , deriv_strategy = fmap (L loc . cvtDerivStrategy) ds + , deriv_strategy = ds' , deriv_type = mkLHsSigWcType inst_ty' , deriv_overlap_mode = Nothing } } @@ -1229,14 +1230,17 @@ cvtPred = cvtType cvtDerivClause :: TH.DerivClause -> CvtM (LHsDerivingClause GhcPs) cvtDerivClause (TH.DerivClause ds ctxt) - = do { ctxt'@(L loc _) <- fmap (map mkLHsSigType) <$> cvtContext ctxt - ; let ds' = fmap (L loc . cvtDerivStrategy) ds + = do { ctxt' <- fmap (map mkLHsSigType) <$> cvtContext ctxt + ; ds' <- traverse cvtDerivStrategy ds ; returnL $ HsDerivingClause noExt ds' ctxt' } -cvtDerivStrategy :: TH.DerivStrategy -> Hs.DerivStrategy -cvtDerivStrategy TH.StockStrategy = Hs.StockStrategy -cvtDerivStrategy TH.AnyclassStrategy = Hs.AnyclassStrategy -cvtDerivStrategy TH.NewtypeStrategy = Hs.NewtypeStrategy +cvtDerivStrategy :: TH.DerivStrategy -> CvtM (Hs.LDerivStrategy GhcPs) +cvtDerivStrategy TH.StockStrategy = returnL Hs.StockStrategy +cvtDerivStrategy TH.AnyclassStrategy = returnL Hs.AnyclassStrategy +cvtDerivStrategy TH.NewtypeStrategy = returnL Hs.NewtypeStrategy +cvtDerivStrategy (TH.ViaStrategy ty) = do + ty' <- cvtType ty + returnL $ Hs.ViaStrategy (mkLHsSigType ty') cvtType :: TH.Type -> CvtM (LHsType GhcPs) cvtType = cvtTypeKind "type" |