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/Quote.hs | |
| parent | 5b157eb2bea7fc4ad654c83258cf1ab6ad0f85f0 (diff) | |
| download | haskell-10124b16538091806953d732e24ca485a0664895.tar.gz | |
template-haskell: Add support for default declarations
Fixes #19373
Diffstat (limited to 'compiler/GHC/HsToCore/Quote.hs')
| -rw-r--r-- | compiler/GHC/HsToCore/Quote.hs | 11 |
1 files changed, 8 insertions, 3 deletions
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 |