large-anon 0.3.0 → 0.3.1

raw patch · 10 files changed

+120/−62 lines, 10 filesdep ~aesondep ~basedep ~containersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: aeson, base, containers, deepseq, ghc, ghc-tcplugin-api, mtl, primitive

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• large-anon.cabal +10/−12
• src/Data/Record/Anon/Advanced.hs +4/−4
• src/Data/Record/Anon/Internal/Core/FieldName.hs +1/−1
• src/Data/Record/Anon/Internal/Plugin/Source/GhcShim.hs +59/−17
• src/Data/Record/Anon/Internal/Plugin/TC/Constraints/AllFields.hs +3/−14
• src/Data/Record/Anon/Internal/Plugin/TC/GhcTcPluginAPI.hs +6/−5
• src/Data/Record/Anon/Internal/Plugin/TC/NameResolution.hs +2/−2
• src/Data/Record/Anon/Internal/Util/StrictArray.hs +13/−5
• src/Data/Record/Anon/Plugin/Internal/Runtime.hs +17/−2

@@ -1,5 +1,10 @@ # Revision history for large-anon +## 0.3.1 -- 2024-05-30++* Support ghc 9.6 (and drop ghc <= 8.8)+  [together with Gabriele Sales]+ ## 0.3 -- 2023-07-04  * Critical bugfix (#146): incremental record construction was fundamentally

@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               large-anon-version:            0.3.0+version:            0.3.1 synopsis:           Scalable anonymous records description:        The @large-anon@ package provides support for anonymous                     records in Haskell, with a focus on compile-time (and@@ -12,7 +12,7 @@ category:           Records extra-source-files: CHANGELOG.md                     test/Test/Sanity/RebindableSyntax/Tests.hs-tested-with:        GHC ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.8 || ==9.4.5+tested-with:        GHC ==8.10.7 || ==9.2.8 || ==9.4.8 || ==9.6.4  library   exposed-modules:@@ -70,15 +70,16 @@       Data.Record.Anon.Internal.Plugin.Source.Options    build-depends:-      base             >= 4.13  && < 4.18-    , aeson            >= 1.4.4 && < 2.2-    , containers       >= 0.6.2 && < 0.7-    , deepseq          >= 1.4.4 && < 1.5-    , ghc-tcplugin-api >= 0.10  && < 0.11+    , aeson            >= 1.4.4 && < 2.3+    , base             >= 4.14  && < 4.19+    , containers       >= 0.6.2 && < 0.8+    , deepseq          >= 1.4.4 && < 1.6+    , ghc              >= 8.10  && < 9.7 +    , ghc-tcplugin-api >= 0.11  && < 0.12     , hashable         >= 1.3   && < 1.5-    , mtl              >= 2.2.1 && < 2.3+    , mtl              >= 2.2.1 && < 2.4     , optics-core      >= 0.3   && < 0.5-    , primitive        >= 0.7.1 && < 0.8+    , primitive        >= 0.8   && < 0.10     , record-hasfield  >= 1.0   && < 1.1     , sop-core         >= 0.5   && < 0.6     , syb              >= 0.7   && < 0.8@@ -87,9 +88,6 @@        -- large-generics 0.2 starts using 'SmallArray' instead of 'Vector'     , large-generics   >= 0.2   && < 0.3--      -- Whatever version is bundled with ghc-    , ghc   hs-source-dirs:       src   default-language:

@@ -205,7 +205,7 @@ -- absentField r = get #c r -- :} -- ...--- ...No instance for (RowHasField "c"...+-- ...No instance for...RowHasField "c"... -- ... -- -- Type mismatches will result in regular type errors:@@ -226,7 +226,7 @@ -- unknownField r = get #b r -- :} -- ...--- ...No instance for (RowHasField "b"...+-- ...No instance for...RowHasField "b"... -- ... -- -- (Note that @x@ here is a variable, not a string.) It is important that the@@ -280,7 +280,7 @@ -- example = project -- :} -- ...--- ...No instance for (SubRow...+-- ...No instance for...SubRow... -- ... -- -- Type inference will work through projections: field types are unified based@@ -347,7 +347,7 @@ -- example r = get #b r -- :} -- ...--- ...No instance for (RowHasField "b"...+-- ...No instance for...RowHasField "b"... -- ... merge :: Record f r -> Record f r' -> Record f (Merge r r') merge = A.merge

@@ -63,6 +63,6 @@     showString "fromString " . showsPrec 11 (fieldNameLabel n)  instance Outputable FieldName where-  ppr = ppr . fieldNameLabel+  ppr = pprString . fieldNameLabel  

@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE DisambiguateRecordFields #-}  -- | Thin shim around the GHC API --@@ -102,7 +103,6 @@ import GHC.Types.Name (mkInternalName) import GHC.Types.Name.Occurrence import GHC.Types.Name.Reader (RdrName(Exact), rdrNameOcc, mkRdrQual, mkRdrUnqual)-import GHC.Types.SrcLoc (LayoutInfo(NoLayoutInfo)) import GHC.Types.Unique (Unique) import GHC.Types.Unique.Supply (takeUniqFromSupply) import GHC.Utils.Monad@@ -113,13 +113,16 @@ import GHC.Driver.Errors import GHC.Types.SourceText (SourceText(NoSourceText)) import GHC.Unit.Finder (findImportedModule, FindResult(Found))-import GHC.Unit.Types (IsBootInterface(NotBoot)) #else import GHC.Driver.Finder (findImportedModule) import GHC.Driver.Types import GHC.Types.Basic (SourceText(NoSourceText)) #endif +#if __GLASGOW_HASKELL__ >= 902 && __GLASGOW_HASKELL__ < 906+import GHC.Unit.Types (IsBootInterface(NotBoot))+#endif+ #if __GLASGOW_HASKELL__ < 904 import Data.IORef @@ -131,14 +134,22 @@ import GHC.Driver.Errors.Types (GhcMessage(..)) import GHC.Iface.Env (lookupNameCache) import GHC.Rename.Names (renamePkgQual)-import GHC.Types.Error (MsgEnvelope(..), mkMessages) import GHC.Types.Name.Cache (NameCache, takeUniqFromNameCache) import GHC.Types.PkgQual (RawPkgQual(NoRawPkgQual)) import GHC.Utils.Error (mkPlainError)+import qualified GHC.Types.Error as Err #endif  #endif +#if __GLASGOW_HASKELL__ >= 900 && __GLASGOW_HASKELL__ < 906+import GHC.Types.SrcLoc (LayoutInfo(NoLayoutInfo))+#endif++#if __GLASGOW_HASKELL__ >= 906+import GHC.Driver.Config.Diagnostic (initPrintConfig)+#endif+ {-------------------------------------------------------------------------------   Names -------------------------------------------------------------------------------}@@ -206,8 +217,18 @@ -- | Optionally @qualified@ import declaration 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+#endif     , ideclName      = reLocA $ noLoc name #if __GLASGOW_HASKELL__ >= 904     , ideclPkgQual   = NoRawPkgQual@@ -215,19 +236,22 @@     , 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     }  issueWarning :: SrcSpan -> SDoc -> Hsc ()@@ -239,11 +263,31 @@       mkWarnMsg l neverQualify errMsg #elif __GLASGOW_HASKELL__ >= 904     logger <- getLogger-    liftIO $ printOrThrowDiagnostics logger (initDiagOpts dynFlags) . mkMessages . bag $-      MsgEnvelope {++#if __GLASGOW_HASKELL__ < 906+    let printOrThrow :: Err.Messages GhcMessage -> IO ()+        printOrThrow = printOrThrowDiagnostics+                         logger+                         (initDiagOpts dynFlags)++    let msg :: Err.DiagnosticMessage+        msg = mkPlainError [] errMsg+#else+    let printOrThrow :: Err.Messages GhcMessage -> IO ()+        printOrThrow = printOrThrowDiagnostics+                         logger+                         (initPrintConfig dynFlags)+                         (initDiagOpts dynFlags)++    let msg :: Err.UnknownDiagnostic+        msg = Err.UnknownDiagnostic $+                mkPlainError [] errMsg+#endif+    liftIO $ printOrThrow . Err.mkMessages . bag $+      Err.MsgEnvelope {           errMsgSpan       = l         , errMsgContext    = neverQualify-        , errMsgDiagnostic = GhcUnknownMessage $ mkPlainError [] errMsg+        , errMsgDiagnostic = GhcUnknownMessage msg         , errMsgSeverity   = SevWarning         } #else@@ -269,15 +313,10 @@ 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__ >= 900 && __GLASGOW_HASKELL__ < 906 instance HasDefaultExt LayoutInfo where   defExt = NoLayoutInfo #endif@@ -307,6 +346,9 @@ mkLabel l n = reLocA $ L l             $ HsOverLabel defExt #if __GLASGOW_HASKELL__ < 902-                 Nothing+                 Nothing -- RebindableSyntax+#elif __GLASGOW_HASKELL__ >= 906+                 NoSourceText #endif+                  n

@@ -117,21 +117,10 @@      dictForField :: KnownField (Type, EvVar) -> TcPluginM 'Solve EvExpr     dictForField KnownField{ knownFieldInfo = (fieldType, dict) } = do-        return $ mkCoreConApps dataConDictAny $ concat [-            map Type typeArgsDict-          , [ -- We have a dictionary of type @c a@ from the evidence we get-              -- from ghc; we cast it to @c Any@ to serve as arg to @DictAny@.-               mkCoreApps (Var idUnsafeCoerce) [-                Type $ mkAppTy allFieldsTypeConstraint fieldType-              , Type $ mkAppTy allFieldsTypeConstraint anyAtKind-              , Var dict-              ]-            ]+        return $ mkCoreApps (Var idMkDictAny) $ concat [+            map Type (typeArgsDict ++ [fieldType])+          , [Var dict]           ]--    -- Any at kind @k@-    anyAtKind :: Type-    anyAtKind = mkTyConApp anyTyCon [allFieldsTypeKind]  {-------------------------------------------------------------------------------   Solver

@@ -21,6 +21,7 @@     -- * New functonality   , isCanonicalVarEq   , getModule+  , pprString   ) where  import GHC.Stack@@ -36,10 +37,6 @@ import GHC.Core.Make import GHC.Utils.Outputable -#if __GLASGOW_HASKELL__ >= 808 &&  __GLASGOW_HASKELL__ < 810-import TcRnTypes (Ct(..))-#endif- #if __GLASGOW_HASKELL__ >= 810 &&  __GLASGOW_HASKELL__ < 900 import Constraint (Ct(..)) #endif@@ -53,7 +50,7 @@ #endif  isCanonicalVarEq :: Ct -> Maybe (TcTyVar, Type)-#if __GLASGOW_HASKELL__ >= 808 &&  __GLASGOW_HASKELL__ < 902+#if __GLASGOW_HASKELL__ >= 810 &&  __GLASGOW_HASKELL__ < 902 isCanonicalVarEq = \case     CTyEqCan{..}  -> Just (cc_tyvar, cc_rhs)     CFunEqCan{..} -> Just (cc_fsk, mkTyConApp cc_fun cc_tyargs)@@ -98,3 +95,7 @@         , " in package "         , pkg         ]++pprString :: String -> SDoc+pprString = text+

@@ -23,7 +23,7 @@     , idEvidenceKnownHash   :: Id     , idEvidenceRowHasField :: Id     , idEvidenceSubRow      :: Id-    , idUnsafeCoerce        :: Id+    , idMkDictAny           :: Id     , tyConDictAny          :: TyCon     , tyConMerge            :: TyCon     , tyConFieldTypes       :: TyCon@@ -60,7 +60,7 @@     idEvidenceKnownHash   <- getVar "evidenceKnownHash"     idEvidenceRowHasField <- getVar "evidenceRowHasField"     idEvidenceSubRow      <- getVar "evidenceSubRow"-    idUnsafeCoerce        <- getVar "noInlineUnsafeCo"+    idMkDictAny           <- getVar "mkDictAny"      tyConDictAny          <- getTyCon       "DictAny"     tyConFieldTypes       <- getTyCon       "FieldTypes"

@@ -254,11 +254,11 @@     i' = arrayIndex (sizeofSmallArray arr) i  writeSmallArray :: ArrayIndex i => SmallMutableArray s a -> i -> a -> ST s ()-writeSmallArray arr i a = boundsCheckM arr i' $-    SmallArray.writeSmallArray arr i' a-  where-    i' :: Int-    i' = arrayIndex (sizeofSmallMutableArray arr) i+writeSmallArray arr i a = do+    sz <- getSizeofSmallMutableArray arr+    let i' = arrayIndex sz i+    boundsCheckM arr i' $+      SmallArray.writeSmallArray arr i' a  #ifdef DEBUG boundsCheck :: HasCallStack => SmallArray a -> Int -> r -> r@@ -288,3 +288,11 @@ boundsCheckM _arr _i k = k #endif +{-------------------------------------------------------------------------------+  Auxiliary: support primitive < 0.9+-------------------------------------------------------------------------------}++#if !MIN_VERSION_primitive(0,9,0)+getSizeofSmallMutableArray :: SmallMutableArray s a -> ST s Int+getSizeofSmallMutableArray = return . sizeofSmallMutableArray+#endif

@@ -10,11 +10,14 @@ {-# LANGUAGE TypeApplications       #-} {-# LANGUAGE TypeFamilies           #-} +-- Since this module is intended for codegen, where we generate explicit type+-- arguments anyway, ambiguous types are a non-issue.+{-# LANGUAGE AllowAmbiguousTypes #-}++-- Users should not need to import from this module directly. {-# OPTIONS_HADDOCK hide #-}  -- | Runtime for code generated by the plugin------ Users should not need to import from this module directly. module Data.Record.Anon.Plugin.Internal.Runtime (     -- * Row     Pair(..)@@ -34,6 +37,7 @@     -- * AllFields   , AllFields(..)   , DictAny(..)+  , mkDictAny   , DictAllFields   , evidenceAllFields     -- * KnownHash@@ -184,6 +188,17 @@ data DictAny c where   DictAny :: c Any => DictAny c +mkDictAny :: forall k (c :: k -> Constraint) (a :: k). c a => DictAny c+mkDictAny = aux $ noInlineUnsafeCo @(Dict c a) @(Dict c Any) Dict+  where+    aux :: Dict c Any -> DictAny c+    aux Dict = DictAny++-- | Construct evidence for the 'AllFields' class+--+-- For reasons currently unclear, /must/ be marked NOINLINE, otherwise we get+-- @-dcore-lint@ errors in @ghc 9.6@.+{-# NOINLINE evidenceAllFields #-} evidenceAllFields :: forall k r c. [DictAny c] -> DictAllFields k r c evidenceAllFields = Tagged . smallArrayFromList