diff options
author | Mario Blažević <blamario@protonmail.com> | 2021-03-07 12:01:56 -0500 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-07-21 02:47:25 -0400 |
commit | 10124b16538091806953d732e24ca485a0664895 (patch) | |
tree | 179bba83b2daccb63cad2b8d6288209b614ec77d /compiler/GHC/HsToCore | |
parent | 5b157eb2bea7fc4ad654c83258cf1ab6ad0f85f0 (diff) | |
download | haskell-10124b16538091806953d732e24ca485a0664895.tar.gz |
template-haskell: Add support for default declarations
Fixes #19373
Diffstat (limited to 'compiler/GHC/HsToCore')
-rw-r--r-- | compiler/GHC/HsToCore/Errors/Ppr.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/HsToCore/Errors/Types.hs | 1 | ||||
-rw-r--r-- | compiler/GHC/HsToCore/Quote.hs | 11 |
3 files changed, 8 insertions, 6 deletions
diff --git a/compiler/GHC/HsToCore/Errors/Ppr.hs b/compiler/GHC/HsToCore/Errors/Ppr.hs index 6c65b14e20..c8bda5562b 100644 --- a/compiler/GHC/HsToCore/Errors/Ppr.hs +++ b/compiler/GHC/HsToCore/Errors/Ppr.hs @@ -163,8 +163,6 @@ instance Diagnostic DsMessage where ThWarningAndDeprecationPragmas decl -> mkMsg "WARNING and DEPRECATION pragmas" $ text "Pragma for declaration of" <+> ppr decl - ThDefaultDeclarations decl - -> mkMsg "Default declarations" (ppr decl) ThSplicesWithinDeclBrackets -> mkMsg "Splices within declaration brackets" empty where diff --git a/compiler/GHC/HsToCore/Errors/Types.hs b/compiler/GHC/HsToCore/Errors/Types.hs index 950d4aa42a..9a98e764e2 100644 --- a/compiler/GHC/HsToCore/Errors/Types.hs +++ b/compiler/GHC/HsToCore/Errors/Types.hs @@ -191,7 +191,6 @@ data ThRejectionReason | ThNegativeOverloadedPatterns !(Pat GhcRn) | ThHaddockDocumentation | ThWarningAndDeprecationPragmas [LIdP GhcRn] - | ThDefaultDeclarations !(DefaultDecl GhcRn) | ThSplicesWithinDeclBrackets data NegLiteralExtEnabled 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 |