diff options
Diffstat (limited to 'compiler/GHC')
| -rw-r--r-- | compiler/GHC/Builtin/Names/TH.hs | 8 | ||||
| -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 | ||||
| -rw-r--r-- | compiler/GHC/ThToHs.hs | 4 |
5 files changed, 17 insertions, 9 deletions
diff --git a/compiler/GHC/Builtin/Names/TH.hs b/compiler/GHC/Builtin/Names/TH.hs index 07a8583662..ceba3042d7 100644 --- a/compiler/GHC/Builtin/Names/TH.hs +++ b/compiler/GHC/Builtin/Names/TH.hs @@ -72,7 +72,7 @@ templateHaskellNames = [ classDName, instanceWithOverlapDName, standaloneDerivWithStrategyDName, sigDName, kiSigDName, forImpDName, pragInlDName, pragSpecDName, pragSpecInlDName, pragSpecInstDName, - pragRuleDName, pragCompleteDName, pragAnnDName, defaultSigDName, + pragRuleDName, pragCompleteDName, pragAnnDName, defaultSigDName, defaultDName, dataFamilyDName, openTypeFamilyDName, closedTypeFamilyDName, dataInstDName, newtypeInstDName, tySynInstDName, infixLDName, infixRDName, infixNDName, @@ -353,7 +353,7 @@ recSName = libFun (fsLit "recS") recSIdKey funDName, valDName, dataDName, newtypeDName, tySynDName, classDName, instanceWithOverlapDName, sigDName, kiSigDName, forImpDName, pragInlDName, pragSpecDName, pragSpecInlDName, pragSpecInstDName, pragRuleDName, - pragAnnDName, standaloneDerivWithStrategyDName, defaultSigDName, + pragAnnDName, standaloneDerivWithStrategyDName, defaultSigDName, defaultDName, dataInstDName, newtypeInstDName, tySynInstDName, dataFamilyDName, openTypeFamilyDName, closedTypeFamilyDName, infixLDName, infixRDName, infixNDName, roleAnnotDName, patSynDName, patSynSigDName, @@ -368,6 +368,7 @@ instanceWithOverlapDName = libFun (fsLit "instanceWithOverlapD") standaloneDerivWithStrategyDName = libFun (fsLit "standaloneDerivWithStrategyD") standaloneDerivWithStrategyDIdKey sigDName = libFun (fsLit "sigD") sigDIdKey kiSigDName = libFun (fsLit "kiSigD") kiSigDIdKey +defaultDName = libFun (fsLit "defaultD") defaultDIdKey defaultSigDName = libFun (fsLit "defaultSigD") defaultSigDIdKey forImpDName = libFun (fsLit "forImpD") forImpDIdKey pragInlDName = libFun (fsLit "pragInlD") pragInlDIdKey @@ -878,7 +879,7 @@ funDIdKey, valDIdKey, dataDIdKey, newtypeDIdKey, tySynDIdKey, classDIdKey, newtypeInstDIdKey, tySynInstDIdKey, standaloneDerivWithStrategyDIdKey, infixLDIdKey, infixRDIdKey, infixNDIdKey, roleAnnotDIdKey, patSynDIdKey, patSynSigDIdKey, pragCompleteDIdKey, implicitParamBindDIdKey, - kiSigDIdKey :: Unique + kiSigDIdKey, defaultDIdKey :: Unique funDIdKey = mkPreludeMiscIdUnique 320 valDIdKey = mkPreludeMiscIdUnique 321 dataDIdKey = mkPreludeMiscIdUnique 322 @@ -912,6 +913,7 @@ patSynSigDIdKey = mkPreludeMiscIdUnique 349 pragCompleteDIdKey = mkPreludeMiscIdUnique 350 implicitParamBindDIdKey = mkPreludeMiscIdUnique 351 kiSigDIdKey = mkPreludeMiscIdUnique 352 +defaultDIdKey = mkPreludeMiscIdUnique 353 -- type Cxt = ... cxtIdKey :: Unique 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 diff --git a/compiler/GHC/ThToHs.hs b/compiler/GHC/ThToHs.hs index e452841f7a..8d3df10185 100644 --- a/compiler/GHC/ThToHs.hs +++ b/compiler/GHC/ThToHs.hs @@ -226,6 +226,10 @@ cvtDec (TH.InfixD fx nm) ; returnJustLA (Hs.SigD noExtField (FixSig noAnn (FixitySig noExtField [nm'] (cvtFixity fx)))) } +cvtDec (TH.DefaultD tys) + = do { tys' <- traverse cvtType tys + ; returnJustLA (Hs.DefD noExtField $ DefaultDecl noAnn tys') } + cvtDec (PragmaD prag) = cvtPragmaD prag |