From 10124b16538091806953d732e24ca485a0664895 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mario=20Bla=C5=BEevi=C4=87?= Date: Sun, 7 Mar 2021 12:01:56 -0500 Subject: template-haskell: Add support for default declarations Fixes #19373 --- compiler/GHC/HsToCore/Quote.hs | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) (limited to 'compiler/GHC/HsToCore/Quote.hs') diff --git a/compiler/GHC/HsToCore/Quote.hs b/compiler/GHC/HsToCore/Quote.hs index 71e5ac9655..f68a561957 100644 --- a/compiler/GHC/HsToCore/Quote.hs +++ b/compiler/GHC/HsToCore/Quote.hs @@ -305,7 +305,7 @@ repTopDs group@(HsGroup { hs_valds = valds ; inst_ds <- mapM repInstD instds ; deriv_ds <- mapM repStandaloneDerivD derivds ; fix_ds <- mapM repLFixD fixds - ; _ <- mapM no_default_decl defds + ; def_ds <- mapM repDefD defds ; for_ds <- mapM repForD fords ; _ <- mapM no_warn (concatMap (wd_warnings . unLoc) warnds) @@ -319,6 +319,7 @@ repTopDs group@(HsGroup { hs_valds = valds val_ds ++ catMaybes tycl_ds ++ role_ds ++ kisig_ds ++ (concat fix_ds) + ++ def_ds ++ inst_ds ++ rule_ds ++ for_ds ++ ann_ds ++ deriv_ds) }) ; @@ -332,8 +333,6 @@ repTopDs group@(HsGroup { hs_valds = valds where no_splice (L loc _) = notHandledL (locA loc) ThSplicesWithinDeclBrackets - no_default_decl (L loc decl) - = notHandledL (locA loc) (ThDefaultDeclarations decl) no_warn :: LWarnDecl GhcRn -> MetaM a no_warn (L loc (Warning _ thing _)) = notHandledL (locA loc) (ThWarningAndDeprecationPragmas thing) @@ -798,6 +797,12 @@ rep_fix_d loc (FixitySig _ names (Fixity _ prec dir)) ; return (loc,dec) } ; mapM do_one names } +repDefD :: LDefaultDecl GhcRn -> MetaM (SrcSpan, Core (M TH.Dec)) +repDefD (L loc (DefaultDecl _ tys)) = do { tys1 <- repLTys tys + ; MkC tys2 <- coreListM typeTyConName tys1 + ; dec <- rep2 defaultDName [tys2] + ; return (locA loc, dec)} + repRuleD :: LRuleDecl GhcRn -> MetaM (SrcSpan, Core (M TH.Dec)) repRuleD (L loc (HsRule { rd_name = n , rd_act = act -- cgit v1.2.1