large-records 0.4.2 → 0.4.3

raw patch · 6 files changed

+210/−144 lines, 6 filesdep ~basedep ~containersdep ~ghcPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base, containers, ghc, template-haskell

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• large-records.cabal +14/−12
• src/Data/Record/Internal/GHC/Shim.hs +139/−9
• src/Data/Record/Internal/GHC/TemplateHaskellStyle.hs +28/−17
• src/Data/Record/Internal/Plugin/CodeGen.hs +25/−24
• src/Data/Record/Plugin.hs +0/−82

@@ -1,5 +1,9 @@ # Revision history for large-records +## 0.4.3 -- 2025-07-19++* Support ghc 9.8 (Gabriele Sales)+ ## 0.4.2 -- 2024-10-15  * Support `primitive-0.7.3` (#159, Isaac Elliott).

@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               large-records-version:            0.4.2+version:            0.4.3 synopsis:           Efficient compilation for large records, linear in the size of the record description:        For many reasons, the internal code generated for modules                     that contain records is quadratic in the number of record@@ -16,7 +16,11 @@ maintainer:         edsko@well-typed.com category:           Generics extra-doc-files:    CHANGELOG.md-tested-with:        GHC ==8.10.7 || ==9.2.8 || ==9.4.8 || ==9.6.6+tested-with:        GHC ==8.10.7+                    GHC ==9.2.8+                    GHC ==9.4.8+                    GHC ==9.6.7+                    GHC ==9.8.4  source-repository head   type:     git@@ -44,14 +48,14 @@       Data.Record.Internal.Plugin.Record    build-depends:-    , base             >= 4.14   && < 4.19-    , containers       >= 0.6.2  && < 0.8-    , ghc              >= 8.10   && < 9.7+    , base             >= 4.14   && < 4.20+    , containers       >= 0.6.2  && < 0.9+    , ghc              >= 8.10   && < 9.9     , mtl              >= 2.2.1  && < 2.4     , primitive        >= 0.7.3  && < 0.10     , record-hasfield  >= 1.0    && < 1.1     , syb              >= 0.7    && < 0.8-    , template-haskell >= 2.16   && < 2.21+    , template-haskell >= 2.16   && < 2.22        -- large-generics 0.2 starts using 'SmallArray' instead of 'Vector'     , large-generics >= 0.2 && < 0.3@@ -70,15 +74,13 @@   ghc-options:       -Wall       -Wcompat-      -Wincomplete-uni-patterns+      -Widentities       -Wincomplete-record-updates+      -Wincomplete-uni-patterns+      -Wmissing-export-lists       -Wpartial-fields-      -Widentities       -Wredundant-constraints-      -Wmissing-export-lists--  if impl(ghc >= 8.10)-    ghc-options: -Wunused-packages+      -Wunused-packages  test-suite test-large-records   type:

@@ -67,6 +67,10 @@     -- * Records   , simpleRecordUpdates +    -- * Diagnostics+  , issueError+  , issueWarning+     -- * Re-exports      -- The whole-sale module exports are not ideal for preserving compatibility@@ -141,6 +145,9 @@ #if __GLASGOW_HASKELL__ < 904     , trace #endif+#if __GLASGOW_HASKELL__ >= 908+    , fieldName+#endif     )  #if __GLASGOW_HASKELL__ < 902@@ -170,6 +177,33 @@ import qualified GHC.Types.Basic #endif +#if __GLASGOW_HASKELL__ >= 902+import GHC.Utils.Logger (getLogger)+#endif++#if __GLASGOW_HASKELL__ == 902+import GHC.Types.Error (mkWarnMsg, mkErr, mkDecorated)+import GHC.Driver.Errors (printOrThrowWarnings)+#endif++#if __GLASGOW_HASKELL__ >= 904+import GHC.Driver.Config.Diagnostic (initDiagOpts)+import GHC.Driver.Errors (printOrThrowDiagnostics)+import GHC.Driver.Errors.Types (GhcMessage(GhcUnknownMessage))+import GHC.Types.Error (mkPlainError, mkMessages, mkPlainDiagnostic)+import GHC.Utils.Error (mkMsgEnvelope, mkErrorMsgEnvelope)+#endif++#if __GLASGOW_HASKELL__ >= 908+import GHC.Types.Error (mkSimpleUnknownDiagnostic)+#elif __GLASGOW_HASKELL__ >= 906+import GHC.Types.Error (UnknownDiagnostic(..))+#endif++#if __GLASGOW_HASKELL__ >= 906+import GHC.Driver.Config.Diagnostic (initPrintConfig)+#endif+ {-------------------------------------------------------------------------------   Name resolution -------------------------------------------------------------------------------}@@ -276,7 +310,11 @@ #endif  mkFunBind :: Located RdrName -> [LMatch GhcPs (LHsExpr GhcPs)] -> HsBind GhcPs+#if __GLASGOW_HASKELL__ >= 908+mkFunBind (reLocA -> n) = GHC.mkFunBind (Generated DoPmc) n+#else mkFunBind (reLocA -> n) = GHC.mkFunBind Generated n+#endif  #if __GLASGOW_HASKELL__ < 900 type HsModule = GHC.HsModule GhcPs@@ -347,8 +385,6 @@ #if __GLASGOW_HASKELL__ >= 906 instance HasDefaultExt (LayoutInfo GhcPs) where   defExt = NoLayoutInfo-instance HasDefaultExt GHC.Types.Basic.Origin where-  defExt = Generated instance HasDefaultExt SourceText where   defExt = NoSourceText #elif __GLASGOW_HASKELL__ >= 900@@ -356,6 +392,14 @@   defExt = NoLayoutInfo #endif +#if __GLASGOW_HASKELL__ >= 908+instance HasDefaultExt GHC.Types.Basic.Origin where+  defExt = Generated DoPmc+#elif __GLASGOW_HASKELL__ >= 906+instance HasDefaultExt GHC.Types.Basic.Origin where+  defExt = Generated+#endif+ instance (HasDefaultExt a, HasDefaultExt b) => HasDefaultExt (a, b) where   defExt = (defExt, defExt) @@ -386,7 +430,10 @@   Generalized @forall@ in 9.0 -------------------------------------------------------------------------------} -#if __GLASGOW_HASKELL__ >= 900+#if __GLASGOW_HASKELL__ >= 908+type  HsTyVarBndr pass =  GHC.HsTyVarBndr (HsBndrVis GhcPs) pass+type LHsTyVarBndr pass = GHC.LHsTyVarBndr (HsBndrVis GhcPs) pass+#elif __GLASGOW_HASKELL__ >= 900 type  HsTyVarBndr pass =  GHC.HsTyVarBndr () pass type LHsTyVarBndr pass = GHC.LHsTyVarBndr () pass #endif@@ -406,8 +453,10 @@   -> HsTyVarBndr GhcPs #if __GLASGOW_HASKELL__ < 900 userTyVar = UserTyVar-#else+#elif __GLASGOW_HASKELL__ < 908 userTyVar ext x = UserTyVar ext () (reLocA x)+#else+userTyVar ext x = UserTyVar ext HsBndrRequired (reLocA x) #endif  kindedTyVar ::@@ -417,8 +466,10 @@   -> HsTyVarBndr GhcPs #if __GLASGOW_HASKELL__ < 900 kindedTyVar = KindedTyVar-#else+#elif __GLASGOW_HASKELL__ < 908 kindedTyVar ext k = KindedTyVar ext () (reLocA k)+#else+kindedTyVar ext k = KindedTyVar ext HsBndrRequired (reLocA k) #endif  -- | Like 'hsTyVarName', but don't throw away the location information@@ -437,9 +488,9 @@ setDefaultSpecificity = id #else setDefaultSpecificity :: LHsTyVarBndr GhcPs -> GHC.LHsTyVarBndr Specificity GhcPs-setDefaultSpecificity = mapXRec @GhcPs $ \v -> case v of-    UserTyVar   ext () name      -> UserTyVar   ext SpecifiedSpec name-    KindedTyVar ext () name kind -> KindedTyVar ext SpecifiedSpec name kind+setDefaultSpecificity = mapXRec @GhcPs $ \case+    UserTyVar   ext _ name      -> UserTyVar   ext SpecifiedSpec name+    KindedTyVar ext _ name kind -> KindedTyVar ext SpecifiedSpec name kind #if __GLASGOW_HASKELL__ < 900     XTyVarBndr  ext              -> XTyVarBndr  ext #endif@@ -545,7 +596,9 @@   Records -------------------------------------------------------------------------------} -#if __GLASGOW_HASKELL__ >= 902+#if __GLASGOW_HASKELL__ >= 908+type RupdFlds = LHsRecUpdFields GhcPs+#elif __GLASGOW_HASKELL__ >= 902 type RupdFlds = Either [LHsRecUpdField GhcPs] [LHsRecUpdProj GhcPs] #else type RupdFlds = [LHsRecUpdField GhcPs]@@ -558,8 +611,15 @@  simpleRecordUpdates =     \case+#if __GLASGOW_HASKELL__ >= 908+      RegularRecUpdFields _ flds ->+        mapM (aux (isUnambigous  . unLoc)) flds+      OverloadedRecUpdFields _ flds ->+        mapM (aux (isSingleLabel . unLoc)) flds+#else       Left  flds -> mapM (aux (isUnambigous  . unLoc)) flds       Right flds -> mapM (aux (isSingleLabel . unLoc)) flds+#endif   where     aux :: forall lhs rhs.          (lhs -> Maybe LRdrName)@@ -639,3 +699,73 @@     isUnambigous _                    = Nothing  #endif++{-------------------------------------------------------------------------------+  Diagnostics+-------------------------------------------------------------------------------}++issueError :: SrcSpan -> SDoc -> Hsc ()+issueError l errMsg = do+#if __GLASGOW_HASKELL__ == 902+    throwOneError $+      mkErr l neverQualify (mkDecorated [errMsg])+#elif __GLASGOW_HASKELL__ >= 908+    throwOneError $+      mkErrorMsgEnvelope+        l+        neverQualify+        (GhcUnknownMessage $ mkSimpleUnknownDiagnostic $ mkPlainError [] errMsg)+#elif __GLASGOW_HASKELL__ >= 906+    throwOneError $+      mkErrorMsgEnvelope+        l+        neverQualify+        (GhcUnknownMessage $ UnknownDiagnostic $ mkPlainError [] errMsg)+#elif __GLASGOW_HASKELL__ >= 904+    throwOneError $+      mkErrorMsgEnvelope+        l+        neverQualify+        (GhcUnknownMessage $ mkPlainError [] errMsg)+#else+    dynFlags <- getDynFlags+    throwOneError $+      mkErrMsg dynFlags l neverQualify errMsg+#endif++issueWarning :: SrcSpan -> SDoc -> Hsc ()+issueWarning l errMsg = do+    dynFlags <- getDynFlags+#if __GLASGOW_HASKELL__ == 902+    logger <- getLogger+    liftIO $ printOrThrowWarnings logger dynFlags . bag $+      mkWarnMsg l neverQualify errMsg+#elif __GLASGOW_HASKELL__ >= 906+    logger <- getLogger+    dflags <- getDynFlags+    let print_config = initPrintConfig dflags+    liftIO $ printOrThrowDiagnostics logger print_config (initDiagOpts dynFlags) . mkMessages . bag $+      mkMsgEnvelope+        (initDiagOpts dynFlags)+        l+        neverQualify+#if __GLASGOW_HASKELL__ >= 908+        (GhcUnknownMessage $ mkSimpleUnknownDiagnostic $ mkPlainDiagnostic WarningWithoutFlag [] errMsg)+#else+        (GhcUnknownMessage $ UnknownDiagnostic $ mkPlainDiagnostic WarningWithoutFlag [] errMsg)+#endif+#elif __GLASGOW_HASKELL__ >= 904+    logger <- getLogger+    liftIO $ printOrThrowDiagnostics logger (initDiagOpts dynFlags) . mkMessages . bag $+      mkMsgEnvelope+        (initDiagOpts dynFlags)+        l+        neverQualify+        (GhcUnknownMessage $ mkPlainDiagnostic WarningWithoutFlag [] errMsg)+#else+    liftIO $ printOrThrowWarnings dynFlags . bag $+      mkWarnMsg dynFlags l neverQualify errMsg+#endif+  where+    bag :: a -> Bag a+    bag = listToBag . (:[])

@@ -14,9 +14,9 @@ module Data.Record.Internal.GHC.TemplateHaskellStyle (     -- * Names     nameBase-  , mkExpVar-  , mkTyVar-  , mkTyCon+  , mkNameExp+  , mkNameTy+  , mkNameTyCon   , pattern ExpVar   , pattern TyVar   , pattern TyCon@@ -105,11 +105,12 @@   ) where  import Data.List (foldl')--import Data.Record.Internal.GHC.Shim hiding (mkTyVar) import Data.List.NonEmpty (NonEmpty(..))+ import qualified Data.List.NonEmpty as NE +import Data.Record.Internal.GHC.Shim+ {-------------------------------------------------------------------------------   Internal auxiliary: types of names -------------------------------------------------------------------------------}@@ -132,32 +133,32 @@ nameBase = occNameString . rdrNameOcc . unLoc  -- | Equivalent of 'Language.Haskell.TH.Syntax.mkName', for expression vars-mkExpVar :: SrcSpan -> String -> LRdrName-mkExpVar l = L l . mkRdrUnqual . mkVarOcc+mkNameExp :: SrcSpan -> String -> LRdrName+mkNameExp l = L l . mkRdrUnqual . mkVarOcc  -- | Equivalent of 'Language.Haskell.TH.Syntax.mkName', for type vars-mkTyVar :: SrcSpan -> String -> LRdrName-mkTyVar l = L l . mkRdrUnqual . mkTyVarOcc+mkNameTy :: SrcSpan -> String -> LRdrName+mkNameTy l = L l . mkRdrUnqual . mkTyVarOcc  -- | Equivalent of 'Language.Haskell.TH.Syntax.mkName', for type constructors-mkTyCon :: SrcSpan -> String -> LRdrName-mkTyCon l = L l . mkRdrUnqual . mkTcOcc+mkNameTyCon :: SrcSpan -> String -> LRdrName+mkNameTyCon l = L l . mkRdrUnqual . mkTcOcc --- | Inverse to 'mkExpVar'+-- | Inverse to 'mkNameExp' -- -- NOTE: Defined in terms of 'nameBase', so discards qualifiers. viewExpVar :: LRdrName -> Maybe String viewExpVar n | isTermVar n = Just (nameBase n) viewExpVar _otherwise = Nothing --- | Inverse to 'mkTyVar'+-- | Inverse to 'mkNameTy' -- -- NOTE: Defined in terms of 'nameBase', so discards qualifiers. viewTyVar :: LRdrName -> Maybe String viewTyVar n | isTypeVar n = Just (nameBase n) viewTyVar _otherwise = Nothing --- | Inverse to 'mkTyCon'+-- | Inverse to 'mkNameTyCon' viewTyCon :: LRdrName -> Maybe String viewTyCon n | isTypeCon n = Just (nameBase n) viewTyCon _otherwise = Nothing@@ -241,15 +242,25 @@ recUpdE :: LHsExpr GhcPs -> [(LRdrName, LHsExpr GhcPs)] -> LHsExpr GhcPs recUpdE = \recExpr -> updRec recExpr . map (uncurry updFld)   where+#if __GLASGOW_HASKELL__ >= 908+    updRec :: LHsExpr GhcPs -> [LHsRecUpdField GhcPs GhcPs] -> LHsExpr GhcPs+#else     updRec :: LHsExpr GhcPs -> [LHsRecUpdField GhcPs] -> LHsExpr GhcPs+#endif     updRec expr fields = inheritLoc expr $         RecordUpd defExt expr-#if __GLASGOW_HASKELL__ >= 902+#if __GLASGOW_HASKELL__ >= 908+          $ RegularRecUpdFields noExtField+#elif __GLASGOW_HASKELL__ >= 902           $ Left #endif             fields +#if __GLASGOW_HASKELL__ >= 908+    updFld :: LRdrName -> LHsExpr GhcPs -> LHsRecUpdField GhcPs GhcPs+#else     updFld :: LRdrName -> LHsExpr GhcPs -> LHsRecUpdField GhcPs+#endif     updFld name val = inheritLoc name $ #if __GLASGOW_HASKELL__ >= 904         HsFieldBind@@ -524,10 +535,10 @@     viewRecField         (L _            ConDeclField {-               cd_fld_names = [L _ fieldName]+               cd_fld_names = [L _ name]              , cd_fld_type  = ty              }-        ) = Just $ (viewFieldOcc fieldName, ty)+        ) = Just $ (viewFieldOcc name, ty)     viewRecField _otherwise = Nothing      viewFieldOcc :: FieldOcc GhcPs -> LRdrName

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP                 #-} {-# LANGUAGE LambdaCase          #-} {-# LANGUAGE RecordWildCards     #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -15,7 +16,7 @@ import qualified Data.Generics as SYB  import Data.Record.Internal.GHC.Fresh-import Data.Record.Internal.GHC.Shim hiding (mkTyVar)+import Data.Record.Internal.GHC.Shim import Data.Record.Internal.GHC.TemplateHaskellStyle import Data.Record.Internal.Plugin.Names import Data.Record.Internal.Plugin.Record@@ -112,7 +113,7 @@     -- cannot clash with anything else (no other type vars can be in scope).     vars :: [LRdrName]     vars = [-          mkTyVar recordAnnLoc ("lr_f" <> show i)+          mkNameTy recordAnnLoc ("lr_f" <> show i)         | (i, _) <- zip [1 :: Int ..] recordFields         ] @@ -184,7 +185,7 @@      toVector :: m [LHsDecl GhcPs]     toVector = do-        x    <- freshName $ mkExpVar recordAnnLoc "x"+        x    <- freshName $ mkNameExp recordAnnLoc "x"         args <- mapM (freshName . fieldName) recordFields         return $ [             sigD name $@@ -239,9 +240,9 @@   => QualifiedNames   -> Record -> m [LHsDecl GhcPs] genIndexedAccessor QualifiedNames{..} r@Record{..} = do-    x <- freshName' False $ mkTyVar  recordAnnLoc "x"-    n <- freshName $ mkExpVar recordAnnLoc "n"-    t <- freshName $ mkExpVar recordAnnLoc "t"+    x <- freshName' False $ mkNameTy recordAnnLoc "x"+    n <- freshName $ mkNameExp recordAnnLoc "n"+    t <- freshName $ mkNameExp recordAnnLoc "t"     return [         sigD name $           funT@@ -279,10 +280,10 @@   => QualifiedNames   -> Record -> m [LHsDecl GhcPs] genUnsafeSetIndex QualifiedNames{..} r@Record{..} = do-    x   <- freshName' False $ mkTyVar  recordAnnLoc "x"-    n   <- freshName $ mkExpVar recordAnnLoc "n"-    t   <- freshName $ mkExpVar recordAnnLoc "t"-    val <- freshName $ mkExpVar recordAnnLoc "val"+    x   <- freshName' False $ mkNameTy recordAnnLoc "x"+    n   <- freshName $ mkNameExp recordAnnLoc "n"+    t   <- freshName $ mkNameExp recordAnnLoc "t"+    val <- freshName $ mkNameExp recordAnnLoc "val"     return [       sigD name $                ConT type_Int@@ -316,8 +317,8 @@   => QualifiedNames   -> Record -> Field -> m (LHsDecl GhcPs) genHasFieldInstance QualifiedNames{..} r@Record{..} Field{..} = do-    x <- freshName' False $ mkTyVar  recordAnnLoc "x"-    t <- freshName $ mkExpVar recordAnnLoc "t"+    x <- freshName' False $ mkNameTy recordAnnLoc "x"+    t <- freshName $ mkNameExp recordAnnLoc "t"     return $       instanceD         [equalP (VarT x) fieldType]@@ -362,7 +363,7 @@      MonadFresh m   => QualifiedNames -> Record -> m (LHsDecl GhcPs) genConstraintsClass QualifiedNames{..} r@Record{..} = do-    c <- freshName' False $ mkTyVar recordAnnLoc "c"+    c <- freshName' False $ mkNameTy recordAnnLoc "c"     return $ classD       []       (nameConstraints r)@@ -432,7 +433,7 @@   => QualifiedNames   -> Record -> m (LHsExpr GhcPs) genDict names@QualifiedNames{..} Record{..} = do-    p <- freshName $ mkExpVar recordAnnLoc "p"+    p <- freshName $ mkNameExp recordAnnLoc "p"     return $       lamE1 (varP p) $         appE@@ -458,7 +459,7 @@   => QualifiedNames -> Record -> m (LHsDecl GhcPs) genConstraintsInstance names r@Record{..} = do     body <- genDict names r-    c    <- freshName' False $ mkTyVar recordAnnLoc "c"+    c    <- freshName' False $ mkNameTy recordAnnLoc "c"     return $       instanceD         (genRequiredConstraints r (VarT c))@@ -489,7 +490,7 @@   => QualifiedNames   -> Record -> DynFlags -> m (LHsExpr GhcPs) genMetadata names@QualifiedNames{..} r@Record{..} dynFlags = do-    p <- freshName $ mkExpVar recordAnnLoc "p"+    p <- freshName $ mkNameExp recordAnnLoc "p"     return $       lamE1 (varP p) $         appsE (VarE mkMetadata) [@@ -525,7 +526,7 @@   => QualifiedNames   -> Record -> m (LHsExpr GhcPs) genFrom QualifiedNames{..} r@Record{..} = do-    x <- freshName $ mkExpVar recordAnnLoc "x"+    x <- freshName $ mkNameExp recordAnnLoc "x"     return $       lamE1 (varP x) $         VarE anyArrayToRep `appE` (VarE (nameVectorFrom r) `appE` VarE x)@@ -545,7 +546,7 @@   => QualifiedNames   -> Record -> m (LHsExpr GhcPs) genTo QualifiedNames{..} r@Record{..} = do-    x <- freshName $ mkExpVar recordAnnLoc "x"+    x <- freshName $ mkNameExp recordAnnLoc "x"     return $       lamE1 (varP x) $         VarE (nameVectorTo r) `appE` (VarE anyArrayFromRep `appE` VarE x)@@ -689,12 +690,12 @@ nameConstraints     :: Record -> LRdrName nameDictConstraints :: Record -> LRdrName -nameVectorFrom      = mkDerived mkExpVar "vectorFrom"-nameVectorTo        = mkDerived mkExpVar "vectorTo"-nameUnsafeGetIndex  = mkDerived mkExpVar "unsafeGetIndex"-nameUnsafeSetIndex  = mkDerived mkExpVar "unsafeSetIndex"-nameConstraints     = mkDerived mkTyCon  "Constraints_"-nameDictConstraints = mkDerived mkExpVar "dictConstraints_"+nameVectorFrom      = mkDerived mkNameExp   "vectorFrom"+nameVectorTo        = mkDerived mkNameExp   "vectorTo"+nameUnsafeGetIndex  = mkDerived mkNameExp   "unsafeGetIndex"+nameUnsafeSetIndex  = mkDerived mkNameExp   "unsafeSetIndex"+nameConstraints     = mkDerived mkNameTyCon "Constraints_"+nameDictConstraints = mkDerived mkNameExp   "dictConstraints_"  {-------------------------------------------------------------------------------   Auxiliary

@@ -89,28 +89,6 @@ import Data.Record.Internal.Plugin.Record import Data.Record.Internal.Plugin.Names -#if __GLASGOW_HASKELL__ >= 902-import GHC.Utils.Logger (getLogger)-#endif--#if __GLASGOW_HASKELL__ == 902-import GHC.Types.Error (mkWarnMsg, mkErr, mkDecorated)-import GHC.Driver.Errors (printOrThrowWarnings)-#endif--#if __GLASGOW_HASKELL__ >= 904-import GHC.Driver.Config.Diagnostic (initDiagOpts)-import GHC.Driver.Errors (printOrThrowDiagnostics)-import GHC.Driver.Errors.Types (GhcMessage(GhcUnknownMessage))-import GHC.Types.Error (mkPlainError, mkMessages, mkPlainDiagnostic)-import GHC.Utils.Error (mkMsgEnvelope, mkErrorMsgEnvelope)-#endif--#if __GLASGOW_HASKELL__ >= 906-import GHC.Types.Error (UnknownDiagnostic(..))-import GHC.Driver.Config.Diagnostic (initPrintConfig)-#endif- {-------------------------------------------------------------------------------   Top-level: the plugin proper -------------------------------------------------------------------------------}@@ -249,63 +227,3 @@  isEnabled :: DynFlags -> RequiredExtension -> Bool isEnabled dynflags (RequiredExtension exts) = any (`xopt` dynflags) exts--{--------------------------------------------------------------------------------  Internal auxiliary--------------------------------------------------------------------------------}--issueError :: SrcSpan -> SDoc -> Hsc ()-issueError l errMsg = do-#if __GLASGOW_HASKELL__ == 902-    throwOneError $-      mkErr l neverQualify (mkDecorated [errMsg])-#elif __GLASGOW_HASKELL__ >= 906-    throwOneError $-      mkErrorMsgEnvelope-        l-        neverQualify-        (GhcUnknownMessage $ UnknownDiagnostic $ mkPlainError [] errMsg)-#elif __GLASGOW_HASKELL__ >= 904-    throwOneError $-      mkErrorMsgEnvelope-        l-        neverQualify-        (GhcUnknownMessage $ mkPlainError [] errMsg)-#else-    dynFlags <- getDynFlags-    throwOneError $-      mkErrMsg dynFlags l neverQualify errMsg-#endif--issueWarning :: SrcSpan -> SDoc -> Hsc ()-issueWarning l errMsg = do-    dynFlags <- getDynFlags-#if __GLASGOW_HASKELL__ == 902-    logger <- getLogger-    liftIO $ printOrThrowWarnings logger dynFlags . bag $-      mkWarnMsg l neverQualify errMsg-#elif __GLASGOW_HASKELL__ >= 906-    logger <- getLogger-    dflags <- getDynFlags-    let print_config = initPrintConfig dflags-    liftIO $ printOrThrowDiagnostics logger print_config (initDiagOpts dynFlags) . mkMessages . bag $-      mkMsgEnvelope-        (initDiagOpts dynFlags)-        l-        neverQualify-        (GhcUnknownMessage $ UnknownDiagnostic $ mkPlainDiagnostic WarningWithoutFlag [] errMsg)-#elif __GLASGOW_HASKELL__ >= 904-    logger <- getLogger-    liftIO $ printOrThrowDiagnostics logger (initDiagOpts dynFlags) . mkMessages . bag $-      mkMsgEnvelope-        (initDiagOpts dynFlags)-        l-        neverQualify-        (GhcUnknownMessage $ mkPlainDiagnostic WarningWithoutFlag [] errMsg)-#else-    liftIO $ printOrThrowWarnings dynFlags . bag $-      mkWarnMsg dynFlags l neverQualify errMsg-#endif-  where-    bag :: a -> Bag a-    bag = listToBag . (:[])