large-records 0.4 → 0.4.1
raw patch · 7 files changed
+132/−39 lines, 7 filesdep ~basedep ~containersdep ~ghcPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base, containers, ghc, mtl, primitive, template-haskell
API changes (from Hackage documentation)
Files
- CHANGELOG.md +5/−0
- large-records.cabal +10/−12
- src/Data/Record/Internal/GHC/Shim.hs +41/−17
- src/Data/Record/Internal/GHC/TemplateHaskellStyle.hs +43/−6
- src/Data/Record/Internal/Plugin/Options.hs +5/−0
- src/Data/Record/Plugin.hs +25/−2
- test/Test/Record/Util.hs +3/−2
CHANGELOG.md view
@@ -1,5 +1,10 @@ # Revision history for large-records +## 0.4.1 -- 2024-05-30++* Support ghc 9.6 (and drop ghc <= 8.8)+ [together with Tristan Cacqueray and Gabriele Sales]+ ## 0.4 -- 2023-03-06 * Fix issue with operator type families used in fields (#120).
large-records.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: large-records-version: 0.4+version: 0.4.1 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,7 @@ maintainer: edsko@well-typed.com category: Generics extra-source-files: CHANGELOG.md-tested-with: GHC ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.7 || ==9.4.4+tested-with: GHC ==8.10.7 || ==9.2.8 || ==9.4.8 || ==9.6.4 source-repository head type: git@@ -44,12 +44,14 @@ Data.Record.Internal.Plugin.Record build-depends:- base >= 4.13 && < 4.18- , containers >= 0.6.2 && < 0.7- , mtl >= 2.2.1 && < 2.3- , primitive >= 0.7 && < 0.8- , syb >= 0.7 && < 0.8- , record-hasfield >= 1.0 && < 1.1+ , base >= 4.14 && < 4.19+ , containers >= 0.6.2 && < 0.8+ , ghc >= 8.10 && < 9.7+ , mtl >= 2.2.1 && < 2.4+ , primitive >= 0.8 && < 0.10+ , record-hasfield >= 1.0 && < 1.1+ , syb >= 0.7 && < 0.8+ , template-haskell >= 2.16 && < 2.21 -- large-generics 0.2 starts using 'SmallArray' instead of 'Vector' , large-generics >= 0.2 && < 0.3@@ -59,10 +61,6 @@ -- 0.2.16 introduces support for ghc 9.4 , record-dot-preprocessor >= 0.2.16 && < 0.3-- -- whatever versions are bundled with ghc- , ghc- , template-haskell hs-source-dirs: src default-language:
src/Data/Record/Internal/GHC/Shim.hs view
@@ -165,6 +165,11 @@ #endif +#if __GLASGOW_HASKELL__ >= 906+import Language.Haskell.Syntax.Basic (FieldLabelString (..))+import qualified GHC.Types.Basic+#endif+ {------------------------------------------------------------------------------- Name resolution -------------------------------------------------------------------------------}@@ -224,30 +229,43 @@ -------------------------------------------------------------------------------} -- | Optionally @qualified@ import declaration-importDecl :: ModuleName -> Bool -> LImportDecl GhcPs-importDecl name qualified = noLocA $ ImportDecl {+importDecl :: Bool -> ModuleName -> LImportDecl GhcPs+importDecl qualified name = reLocA $ noLoc $ ImportDecl {+#if __GLASGOW_HASKELL__ < 906 ideclExt = defExt+#else+ ideclExt = XImportDeclPass {+ ideclAnn = defExt+ , ideclSourceText = NoSourceText+ , ideclImplicit = False+ }+#endif+#if __GLASGOW_HASKELL__ < 906 , ideclSourceSrc = NoSourceText- , ideclName = noLocA name+#endif+ , ideclName = reLocA $ noLoc name #if __GLASGOW_HASKELL__ >= 904 , ideclPkgQual = NoRawPkgQual #else , ideclPkgQual = Nothing #endif , ideclSafe = False+#if __GLASGOW_HASKELL__ < 906 , ideclImplicit = False+#endif , ideclAs = Nothing+#if __GLASGOW_HASKELL__ < 906 , ideclHiding = Nothing-#if __GLASGOW_HASKELL__ < 810- , ideclQualified = qualified-#else- , ideclQualified = if qualified then QualifiedPre else NotQualified #endif+ , ideclQualified = if qualified then QualifiedPre else NotQualified #if __GLASGOW_HASKELL__ < 900 , ideclSource = False #else , ideclSource = NotBoot #endif+#if __GLASGOW_HASKELL__ >= 906+ , ideclImportList = Nothing+#endif } conPat :: Located RdrName -> HsConPatDetails GhcPs -> Pat GhcPs@@ -258,11 +276,7 @@ #endif mkFunBind :: Located RdrName -> [LMatch GhcPs (LHsExpr GhcPs)] -> HsBind GhcPs-#if __GLASGOW_HASKELL__ < 810-mkFunBind = GHC.mkFunBind-#else mkFunBind (reLocA -> n) = GHC.mkFunBind Generated n-#endif #if __GLASGOW_HASKELL__ < 900 type HsModule = GHC.HsModule GhcPs@@ -270,7 +284,11 @@ type HsModule = GHC.HsModule #endif +#if __GLASGOW_HASKELL__ >= 906+type LHsModule = Located (HsModule GhcPs)+#else type LHsModule = Located HsModule+#endif type LRdrName = Located RdrName {-------------------------------------------------------------------------------@@ -323,15 +341,17 @@ class HasDefaultExt a where defExt :: a -#if __GLASGOW_HASKELL__ < 810-instance HasDefaultExt NoExt where- defExt = noExt-#else instance HasDefaultExt NoExtField where defExt = noExtField-#endif -#if __GLASGOW_HASKELL__ >= 900+#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 instance HasDefaultExt LayoutInfo where defExt = NoLayoutInfo #endif@@ -559,7 +579,11 @@ isSingleLabel :: FieldLabelStrings GhcPs -> Maybe LRdrName isSingleLabel (FieldLabelStrings labels) = case labels of+#if __GLASGOW_HASKELL__ >= 906+ [L _ (DotFieldOcc _ (L l (FieldLabelString label)))] ->+#else [L _ (DotFieldOcc _ (L l label))] ->+#endif Just $ reLoc $ L l (Unqual $ mkVarOccFS label) _otherwise -> Nothing
src/Data/Record/Internal/GHC/TemplateHaskellStyle.hs view
@@ -289,7 +289,11 @@ lamE :: NonEmpty (LPat GhcPs) -> LHsExpr GhcPs -> LHsExpr GhcPs lamE pats body = inheritLoc body $ HsLam defExt $+#if __GLASGOW_HASKELL__ >= 906+ MG defExt (inheritLoc body [inheritLoc body match])+#else MG defExt (inheritLoc body [inheritLoc body match]) Generated+#endif where match :: Match GhcPs (LHsExpr GhcPs) match = Match defExt LambdaExpr (NE.toList pats) (simpleGHRSs body)@@ -301,7 +305,11 @@ -- | Equivalent of 'Language.Haskell.TH.Lib.caseE' caseE :: LHsExpr GhcPs -> [(LPat GhcPs, LHsExpr GhcPs)] -> LHsExpr GhcPs caseE x alts = inheritLoc x $+#if __GLASGOW_HASKELL__ >= 906+ HsCase defExt x (MG defExt (inheritLoc x (map mkAlt alts)))+#else HsCase defExt x (MG defExt (inheritLoc x (map mkAlt alts)) Generated)+#endif where mkAlt :: (LPat GhcPs, LHsExpr GhcPs) -> LMatch GhcPs (LHsExpr GhcPs) mkAlt (pat, body) = inheritLoc x $@@ -314,6 +322,9 @@ -- | Equivalent of 'Language.Haskell.TH.Lib.appT' appTypeE :: LHsExpr GhcPs -> LHsType GhcPs -> LHsExpr GhcPs appTypeE expr typ = inheritLoc expr $+#if __GLASGOW_HASKELL__ >= 906+ HsAppType noExtField expr noHsTok (HsWC defExt typ)+#else HsAppType #if __GLASGOW_HASKELL__ >= 902 (toSrcSpan expr)@@ -322,7 +333,7 @@ #endif expr (HsWC defExt typ)-+#endif -- | Equivalent of 'Language.Haskell.TH.Lib.tupE' tupE :: NonEmpty (LHsExpr GhcPs) -> LHsExpr GhcPs tupE xs = inheritLoc xs $@@ -353,7 +364,11 @@ parensT = noLocA . HsParTy defExt -- | Equivalent of 'Language.Haskell.TH.Lib.litT'+#if __GLASGOW_HASKELL__ >= 906+litT :: HsTyLit GhcPs -> LHsType GhcPs+#else litT :: HsTyLit -> LHsType GhcPs+#endif litT = noLocA . HsTyLit defExt -- | Equivalent of 'Language.Haskell.TH.Lib.varT'@@ -604,7 +619,10 @@ , tcdFixity = Prefix , tcdDataDefn = HsDataDefn { dd_ext = defExt+#if __GLASGOW_HASKELL__ >= 906+#else , dd_ND = DataType+#endif #if __GLASGOW_HASKELL__ >= 902 , dd_ctxt = Nothing #else@@ -612,7 +630,11 @@ #endif , dd_cType = Nothing , dd_kindSig = Nothing+#if __GLASGOW_HASKELL__ >= 906+ , dd_cons = DataTypeCons False cons+#else , dd_cons = cons+#endif , dd_derivs = inheritLoc typeName derivs } }@@ -635,15 +657,21 @@ , tcdTyVars = HsQTvs {hsq_explicit = tyVars} , tcdFixity = Prefix , tcdDataDefn = HsDataDefn {- dd_ND = DataType #if __GLASGOW_HASKELL__ >= 902- , dd_ctxt = Nothing+ dd_ctxt = Nothing #else- , dd_ctxt = L _ []+ dd_ctxt = L _ [] #endif+#if !__GLASGOW_HASKELL__ >= 906+ , dd_ND = DataType+#endif , dd_cType = Nothing , dd_kindSig = Nothing+#if __GLASGOW_HASKELL__ >= 906+ , dd_cons = DataTypeCons False cons+#else , dd_cons = cons+#endif #if __GLASGOW_HASKELL__ >= 902 , dd_derivs = derivs #else@@ -746,6 +774,9 @@ classD = \ctx name clsVars sigs -> inheritLoc name $ TyClD defExt $ ClassDecl { tcdCExt = defExt+#if __GLASGOW_HASKELL__ >= 906+ , tcdLayout = NoLayoutInfo+#endif #if __GLASGOW_HASKELL__ >= 902 , tcdCtxt = Just (inheritLoc name ctx) #else@@ -821,14 +852,22 @@ -- | Equivalent of 'Language.Haskell.TH.Lib.pragAnnD' pragAnnD :: AnnProvenancePs -> LHsExpr GhcPs -> AnnDecl GhcPs pragAnnD prov value =+#if __GLASGOW_HASKELL__ >= 906+ HsAnnotation defExt prov value+#else HsAnnotation defExt NoSourceText prov value+#endif viewPragAnnD :: AnnDecl GhcPs -> (AnnProvenancePs, LHsExpr GhcPs)+#if __GLASGOW_HASKELL__ >= 906+viewPragAnnD (HsAnnotation _ prov value) = (prov, value)+#else viewPragAnnD (HsAnnotation _ _ prov value) = (prov, value)+#endif #if __GLASGOW_HASKELL__ < 900 viewPragAnnD _ = panic "viewPragAnnD" #endif@@ -881,5 +920,3 @@ GRHSs defExt [inheritLoc body $ GRHS defExt [] body] (inheritLoc body $ EmptyLocalBinds defExt)--
src/Data/Record/Internal/Plugin/Options.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DerivingStrategies #-}@@ -67,7 +68,11 @@ -- | Extract all 'LargeRecordOptions' in a module -- -- Additionally returns the location of the ANN pragma.+#if __GLASGOW_HASKELL__ >= 906+getLargeRecordOptions :: HsModule GhcPs -> Map String [(SrcSpan, LargeRecordOptions)]+#else getLargeRecordOptions :: HsModule -> Map String [(SrcSpan, LargeRecordOptions)]+#endif getLargeRecordOptions = Map.fromListWith (++) . map (second (:[]))
src/Data/Record/Plugin.hs view
@@ -39,8 +39,10 @@ , plugin ) where -import Control.Monad.Except-import Control.Monad.Trans.Writer.CPS+import Control.Monad+import Control.Monad.Trans.Class (lift)+import Control.Monad.Except (runExcept)+import Control.Monad.Trans.Writer.CPS (WriterT, tell, runWriterT) import Data.List (intersperse) import Data.Map.Strict (Map) import Data.Set (Set)@@ -76,6 +78,11 @@ 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 -------------------------------------------------------------------------------}@@ -213,6 +220,12 @@ #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@@ -232,6 +245,16 @@ 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 $
test/Test/Record/Util.hs view
@@ -18,8 +18,9 @@ ) where import Control.Exception-import Control.Monad.Except hiding (lift)-import Control.Monad.State hiding (lift)+import Control.Monad.Except (ExceptT(..), runExceptT, throwError)+import Control.Monad.IO.Class+import Control.Monad.State (StateT(..), modify) import Data.Bifunctor import Data.List (isPrefixOf) import Language.Haskell.TH