packages feed

large-records 0.4.1 → 0.4.2

raw patch · 24 files changed

+133/−102 lines, 24 filesdep +ghc-primdep ~primitivePVP ok

version bump matches the API change (PVP)

Dependencies added: ghc-prim

Dependency ranges changed: primitive

API changes (from Hackage documentation)

+ Data.Record.Plugin.Runtime: error :: HasCallStack => String -> a
+ Data.Record.Plugin.Runtime: type Int = Int

Files

CHANGELOG.md view
@@ -1,5 +1,20 @@ # Revision history for large-records +## 0.4.2 -- 2024-10-15++* Support `primitive-0.7.3` (#159, Isaac Elliott).+* Plugin idempotence (#159, Isaac Elliott).+* Document required additional dependencies and language extensions (#161).+* Use `Exact` names for `Prelude` imports, to avoid unexpected clashes (#162).++Notes:++* If your code imports `Data.Plugin.Record` only for the `largeRecord`+  identifier used in the `ANN` annotations, this import is no longer required as+  of this version and can be omitted.+* In addition to `large-generics` and `record-hasfield` you will now also need+  to declare a dependency on `ghc-prim`.+ ## 0.4.1 -- 2024-05-30  * Support ghc 9.6 (and drop ghc <= 8.8)
large-records.cabal view
@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               large-records-version:            0.4.1+version:            0.4.2 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@@ -15,8 +15,8 @@ author:             Edsko de Vries maintainer:         edsko@well-typed.com category:           Generics-extra-source-files: CHANGELOG.md-tested-with:        GHC ==8.10.7 || ==9.2.8 || ==9.4.8 || ==9.6.4+extra-doc-files:    CHANGELOG.md+tested-with:        GHC ==8.10.7 || ==9.2.8 || ==9.4.8 || ==9.6.6  source-repository head   type:     git@@ -48,7 +48,7 @@     , containers       >= 0.6.2  && < 0.8     , ghc              >= 8.10   && < 9.7     , mtl              >= 2.2.1  && < 2.4-    , primitive        >= 0.8    && < 0.10+    , primitive        >= 0.7.3  && < 0.10     , record-hasfield  >= 1.0    && < 1.1     , syb              >= 0.7    && < 0.8     , template-haskell >= 2.16   && < 2.21@@ -113,6 +113,7 @@     , large-records      , generic-deriving+    , ghc-prim     , large-generics     , mtl     , newtype
src/Data/Record/Internal/Plugin/CodeGen.hs view
@@ -5,6 +5,8 @@ -- | The core of the plugin implementation. module Data.Record.Internal.Plugin.CodeGen (genLargeRecord) where +import Prelude hiding (error)+ import Data.List (nubBy) import Data.List.NonEmpty (NonEmpty(..)) @@ -159,8 +161,6 @@     , toVector     ]   where-    UnqualifiedNames{..} = getUnqualifiedNames-     fromVector :: m [LHsDecl GhcPs]     fromVector = do         args <- mapM (freshName . fieldName) recordFields@@ -203,7 +203,7 @@                         ]                     )                   , ( wildP-                    , VarE unq_error `appE` stringE matchErr+                    , VarE error `appE` stringE matchErr                     )                   ]           ]@@ -245,7 +245,7 @@     return [         sigD name $           funT-            (ConT unq_type_Int)+            (ConT type_Int)             (recordTypeT r `funT` VarT x)       , valD name $           lamE (varP n :| [varP t]) $@@ -259,8 +259,6 @@               )       ]   where-    UnqualifiedNames{..} = getUnqualifiedNames-     name :: LRdrName     name = nameUnsafeGetIndex r @@ -287,7 +285,7 @@     val <- freshName $ mkExpVar recordAnnLoc "val"     return [       sigD name $-               ConT unq_type_Int+               ConT type_Int         `funT` (recordTypeT r `funT` (VarT x `funT` recordTypeT r))       , valD name $           lamE (varP n :| [varP t, (varP val)]) $@@ -305,8 +303,6 @@               )       ]   where-    UnqualifiedNames{..} = getUnqualifiedNames-     name :: LRdrName     name = nameUnsafeSetIndex r @@ -624,13 +620,11 @@   => QualifiedNames   -> Record -> StockDeriving -> m [LHsDecl GhcPs] genStockInstance QualifiedNames{..} r = pure . \case-    Show    -> [mkInstance unq_type_Show unq_showsPrec gshowsPrec]-    Eq      -> [mkInstance unq_type_Eq   unq_eq        geq       ]-    Ord     -> [mkInstance unq_type_Ord  unq_compare   gcompare  ]+    Show    -> [mkInstance prelude_type_Show prelude_showsPrec gshowsPrec]+    Eq      -> [mkInstance prelude_type_Eq   prelude_eq        geq       ]+    Ord     -> [mkInstance prelude_type_Ord  prelude_compare   gcompare  ]     Generic -> []   where-    UnqualifiedNames{..} = getUnqualifiedNames-     mkInstance :: LRdrName -> LRdrName -> LRdrName -> LHsDecl GhcPs     mkInstance cls mthd gen =         instanceD
src/Data/Record/Internal/Plugin/Names.hs view
@@ -2,14 +2,11 @@ {-# LANGUAGE RecordWildCards   #-}  module Data.Record.Internal.Plugin.Names (-    -- * Qualified names     QualifiedNames(..)   , getQualifiedNames-    -- * Unqualified names-  , UnqualifiedNames(..)-  , getUnqualifiedNames   ) where +import Prelude hiding (error) import Data.Record.Internal.GHC.Shim  {-------------------------------------------------------------------------------@@ -19,17 +16,30 @@ data QualifiedNames = QualifiedNames {        ---      -- Base+      -- Prelude type classes       -- -      type_Constraint  :: LRdrName+      prelude_type_Eq   :: LRdrName+    , prelude_type_Ord  :: LRdrName+    , prelude_type_Show :: LRdrName+    , prelude_compare   :: LRdrName+    , prelude_eq        :: LRdrName+    , prelude_showsPrec :: LRdrName++      --+      -- Other base+      --++    , type_Constraint  :: LRdrName     , type_GHC_Generic :: LRdrName     , type_GHC_Rep     :: LRdrName+    , type_Int         :: LRdrName     , type_Proxy       :: LRdrName     , type_Type        :: LRdrName-    , proxy            :: LRdrName+    , error            :: LRdrName     , ghc_from         :: LRdrName     , ghc_to           :: LRdrName+    , proxy            :: LRdrName        --       -- AnyArray@@ -100,18 +110,35 @@ --   define a dependency on that other package. getQualifiedNames :: Hsc QualifiedNames getQualifiedNames = do+     ---    -- base+    -- Prelude classes     --+    -- Annoyingly, we cannot re-rexport these through our runtime module, since+    -- we cannot declare instances of type aliased classes.+    -- +    prelude_type_Eq   <- exact <$> lookupTcName  ghcClasses (Just "ghc-prim") "Eq"+    prelude_type_Ord  <- exact <$> lookupTcName  ghcClasses (Just "ghc-prim") "Ord"+    prelude_type_Show <- exact <$> lookupTcName  ghcShow    Nothing           "Show"+    prelude_compare   <- exact <$> lookupVarName ghcClasses (Just "ghc-prim") "compare"+    prelude_eq        <- exact <$> lookupVarName ghcClasses (Just "ghc-prim") "=="+    prelude_showsPrec <- exact <$> lookupVarName ghcShow    Nothing           "showsPrec"++    --+    -- Other base+    --+     type_Constraint  <- exact <$> lookupTcName  runtime     Nothing "Constraint"     type_GHC_Generic <- exact <$> lookupTcName  ghcGenerics Nothing "Generic"     type_GHC_Rep     <- exact <$> lookupTcName  ghcGenerics Nothing "Rep"     type_Proxy       <- exact <$> lookupTcName  runtime     Nothing "Proxy"     type_Type        <- exact <$> lookupTcName  runtime     Nothing "Type"-    proxy            <- exact <$> lookupVarName runtime     Nothing "proxy"+    type_Int         <- exact <$> lookupTcName  runtime     Nothing "Int"+    error            <- exact <$> lookupVarName runtime     Nothing "error"     ghc_from         <- exact <$> lookupVarName ghcGenerics Nothing "from"     ghc_to           <- exact <$> lookupVarName ghcGenerics Nothing "to"+    proxy            <- exact <$> lookupVarName runtime     Nothing "proxy"      --     -- AnyArray@@ -173,39 +200,12 @@    exact :: Name -> LRdrName    exact = noLoc . Exact +   ghcClasses, ghcShow :: ModuleName+   ghcClasses = mkModuleName "GHC.Classes"+   ghcShow    = mkModuleName "GHC.Show"+    runtime, recordHasField, ghcGenerics, largeGenerics :: ModuleName    runtime        = mkModuleName "Data.Record.Plugin.Runtime"    recordHasField = mkModuleName "GHC.Records.Compat"    ghcGenerics    = mkModuleName "GHC.Generics"    largeGenerics  = mkModuleName "Data.Record.Generic"--{--------------------------------------------------------------------------------  We use Prelude names unqualified.--------------------------------------------------------------------------------}--data UnqualifiedNames = UnqualifiedNames {-      unq_type_Eq   :: LRdrName-    , unq_type_Int  :: LRdrName-    , unq_type_Ord  :: LRdrName-    , unq_type_Show :: LRdrName-    , unq_compare   :: LRdrName-    , unq_eq        :: LRdrName-    , unq_error     :: LRdrName-    , unq_showsPrec :: LRdrName-    }--getUnqualifiedNames :: UnqualifiedNames-getUnqualifiedNames = UnqualifiedNames {-      unq_type_Eq   = tc "Eq"-    , unq_type_Int  = tc "Int"-    , unq_type_Ord  = tc "Ord"-    , unq_type_Show = tc "Show"-    , unq_compare   = var "compare"-    , unq_eq        = var "=="-    , unq_error     = var "error"-    , unq_showsPrec = var "showsPrec"-    }-  where-    var, tc :: String -> LRdrName-    var x = noLoc $ mkRdrUnqual $ mkVarOcc x-    tc  x = noLoc $ mkRdrUnqual $ mkTcOcc  x
src/Data/Record/Plugin.hs view
@@ -8,14 +8,42 @@ -- -- > {-# OPTIONS_GHC -fplugin=Data.Record.Plugin #-} -- >--- > import Data.Record.Plugin--- > -- > {-# ANN type B largeRecord #-} -- > data B a = B {a :: a, b :: String} -- >   deriving stock (Show, Eq, Ord) -- -- See 'LargeRecordOptions' for the list of all possible annotations. --+-- = Dependencies+--+-- In addition to the dependency on @large-records@, you will also need to add+-- dependencies on+--+-- * [ghc-prim](http://hackage.haskell.org/package/ghc-prim).+-- * [large-generics](http://hackage.haskell.org/package/large-generics)+-- * [record-hasfield](http://hackage.haskell.org/package/record-hasfield).+--+-- = Language extensions+--+-- The plugin depends on a number of language extensions. If you are using+-- GHC2021, you will need enable:+--+-- > {-# LANGUAGE DataKinds             #-}+-- > {-# LANGUAGE TypeFamilies          #-}+-- > {-# LANGUAGE UndecidableInstances  #-}+--+-- If you are using Haskell2010, you need to enable:+--+-- > {-# LANGUAGE ConstraintKinds       #-}+-- > {-# LANGUAGE DataKinds             #-}+-- > {-# LANGUAGE FlexibleInstances     #-}+-- > {-# LANGUAGE GADTs                 #-}+-- > {-# LANGUAGE MultiParamTypeClasses #-}+-- > {-# LANGUAGE ScopedTypeVariables   #-}+-- > {-# LANGUAGE TypeFamilies          #-}+-- > {-# LANGUAGE TypeOperators         #-}+-- > {-# LANGUAGE UndecidableInstances  #-}+-- -- = Usage with @record-dot-preprocessor@ -- -- The easiest way to use both plugins together is to do@@ -135,7 +163,18 @@   -> WriterT (Set String) Hsc [LHsDecl GhcPs] transformDecl largeRecords decl@(reLoc -> L l _) =     case decl of-      DataD (nameBase -> name) _ _ _  ->+      (unLoc -> AnnD _ (PragAnnD (TypeAnnotation (nameBase -> name)) _)) ->+        case Map.findWithDefault [] name largeRecords of+          [_] ->+            {- A valid `large-records` annotation.++            Remove it so that subsequent passes of the plugin will ignore the generated+            `large-records` code.+            -}+            pure []+          _ ->+            pure [decl]+      DataD (nameBase -> name) _ _ _  -> do         case Map.findWithDefault [] name largeRecords of           [] ->             -- Not a large record. Leave alone.
src/Data/Record/Plugin/Runtime.hs view
@@ -11,8 +11,11 @@ -- This exports all functionality required by the generated code, with the -- exception of GHC generics (name clash with @large-records@ generics). module Data.Record.Plugin.Runtime (-    -- * Base-    Constraint+    -- * Prelude+    Int+  , error+    -- * Other base+  , Constraint   , Proxy   , Type   , proxy@@ -43,10 +46,14 @@   , unwrapThroughLRGenerics   ) where +import Prelude hiding (Int, error)+import qualified Prelude as Prelude+ import Control.Monad (forM_) import Data.Coerce (coerce) import Data.Primitive.SmallArray import GHC.Exts (Any)+import GHC.Stack (HasCallStack) import GHC.TypeLits  import qualified Data.Foldable                    as Foldable@@ -59,6 +66,15 @@ import qualified Data.Record.Generic.Show         as LR  {-------------------------------------------------------------------------------+  Prelude+-------------------------------------------------------------------------------}++type Int = Prelude.Int++error :: HasCallStack => String -> a+error = Prelude.error++{-------------------------------------------------------------------------------   base -------------------------------------------------------------------------------} @@ -85,11 +101,11 @@ anyArrayIndex = indexSmallArray  anyArrayUpdate :: AnyArray -> [(Int, Any)] -> AnyArray-anyArrayUpdate v updates = runSmallArray $ do+anyArrayUpdate v updates = runSmallArray (do     v' <- thawSmallArray v 0 (sizeofSmallArray v)-    forM_ updates $ \(i, a) -> do-      writeSmallArray v' i a+    forM_ updates (\(i, a) -> writeSmallArray v' i a)     return v'+  )  {-------------------------------------------------------------------------------   large-generics: utilities@@ -102,7 +118,7 @@ anyArrayFromRep = coerce  mkDicts :: [Dict c Any] -> Rep (Dict c) a-mkDicts = LR.Rep . smallArrayFromList+mkDicts ds = LR.Rep (smallArrayFromList ds)  mkDict :: c x => Proxy c -> Proxy x -> Dict c x mkDict _ _ = LR.Dict@@ -126,7 +142,7 @@       recordName          = name     , recordConstructor   = constr     , recordSize          = length fields-    , recordFieldMetadata = LR.Rep $ smallArrayFromList fields+    , recordFieldMetadata = LR.Rep (smallArrayFromList fields)     }  {-------------------------------------------------------------------------------
test/Test/Record/Sanity/CodeGen.hs view
@@ -16,7 +16,6 @@ module Test.Record.Sanity.CodeGen (tests) where  import Data.Record.Generic-import Data.Record.Plugin  import Test.Tasty import Test.Tasty.HUnit
test/Test/Record/Sanity/Derive.hs view
@@ -24,8 +24,6 @@ import Test.Tasty import Test.Tasty.HUnit -import Data.Record.Plugin- {-------------------------------------------------------------------------------   Class of kind @Type -> Constraint@. -------------------------------------------------------------------------------}
test/Test/Record/Sanity/EqualFieldTypes.hs view
@@ -21,8 +21,6 @@ import Test.Tasty import Test.Tasty.HUnit -import Data.Record.Plugin- {-# ANN type R largeRecord #-} data R a = MkR {       field1 :: a
test/Test/Record/Sanity/GhcGenerics.hs view
@@ -21,8 +21,6 @@  import qualified GHC.Generics as GHC -import Data.Record.Plugin- {-# ANN type R largeRecord #-} data R = MkR { a :: Int }   deriving (Show)
test/Test/Record/Sanity/HKD.hs view
@@ -25,8 +25,6 @@ import Test.Tasty import Test.Tasty.HUnit -import Data.Record.Plugin- type family HKD f a where   HKD Identity  a = a   HKD (Const b) a = b
test/Test/Record/Sanity/HigherKinded.hs view
@@ -26,8 +26,6 @@ import Test.Tasty import Test.Tasty.HUnit -import Data.Record.Plugin- newtype T (n :: Nat) (f :: Type -> Type) = MkT (f Word)  instance LowerBound (T n I) where
test/Test/Record/Sanity/NamedWildCards.hs view
@@ -16,8 +16,6 @@  module Test.Record.Sanity.NamedWildCards where -import Data.Record.Plugin- {-# ANN type X largeRecord #-} data X = MkX { _x :: Int }
test/Test/Record/Sanity/Operators.hs view
@@ -16,8 +16,6 @@  import Data.Kind (Type) -import Data.Record.Plugin- -- Some type family (e.g. servant record-style API def). type family tag :- route :: Type
test/Test/Record/Sanity/OverloadedRecordUpdate.hs view
@@ -39,7 +39,6 @@ import Data.Record.Generic (Rep) import Data.Record.Generic.Lens.VL import Data.Record.Overloading-import Data.Record.Plugin  tests :: TestTree tests = testGroup "Test.Record.Sanity.OverloadedRecordUpdate" [
test/Test/Record/Sanity/OverloadingNoDRF.hs view
@@ -21,8 +21,6 @@ import Test.Tasty import Test.Tasty.HUnit -import Data.Record.Plugin- {-------------------------------------------------------------------------------   Simple test case
test/Test/Record/Sanity/PatternMatch.hs view
@@ -23,8 +23,6 @@ import Test.Tasty import Test.Tasty.HUnit -import Data.Record.Plugin- import Test.Record.Util  {-------------------------------------------------------------------------------
test/Test/Record/Sanity/QualifiedImports/A.hs view
@@ -12,7 +12,5 @@  module Test.Record.Sanity.QualifiedImports.A (T(..)) where -import Data.Record.Plugin- {-# ANN type T largeRecord #-} data T a = MkT { x :: Int, y :: [a] }
test/Test/Record/Sanity/QualifiedImports/B.hs view
@@ -13,8 +13,6 @@  module Test.Record.Sanity.QualifiedImports.B (T(..)) where -import Data.Record.Plugin- import qualified Test.Record.Sanity.QualifiedImports.A as A  {-# ANN type T largeRecord #-}
test/Test/Record/Sanity/RDP/SingleModule.hs view
@@ -20,8 +20,6 @@ import Test.Tasty import Test.Tasty.HUnit -import Data.Record.Plugin- {-------------------------------------------------------------------------------   Simple field selection and override -------------------------------------------------------------------------------}
test/Test/Record/Sanity/RDP/SplitModule/RecordDef.hs view
@@ -23,8 +23,6 @@   , R5_WithLR(..)   ) where -import Data.Record.Plugin- {-# ANN type R1 largeRecord #-} data R1 = MkR1 { r1_x :: Int, r1_y :: Bool }   deriving (Show, Eq)
test/Test/Record/Sanity/RecordConstruction.hs view
@@ -20,8 +20,6 @@ import Test.Tasty import Test.Tasty.HUnit -import Data.Record.Plugin- -- Test that this works if we don't generate field accessors -- See <https://gitlab.haskell.org/ghc/ghc/-/issues/19312> --
test/Test/Record/Sanity/Strictness.hs view
@@ -26,8 +26,6 @@  import qualified Data.Record.Generic.Rep as Rep -import Data.Record.Plugin- {-# ANN type Lazy largeRecord #-} data Lazy = MkLazy { lazyField :: Word }
test/Test/Record/Sanity/StrictnessStrictData.hs view
@@ -27,8 +27,6 @@  import qualified Data.Record.Generic.Rep as Rep -import Data.Record.Plugin- {-# ANN type Lazy largeRecord #-} data Lazy = MkLazy { lazyField :: ~Word }