large-records 0.2.0.0 → 0.2.1.0

raw patch · 5 files changed

+63/−42 lines, 5 filesdep +primitivedep −vectordep ~large-genericsPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: primitive

Dependencies removed: vector

Dependency ranges changed: large-generics

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• large-records.cabal +5/−3
• src/Data/Record/Internal/Plugin/CodeGen.hs +20/−14
• src/Data/Record/Internal/Plugin/Names/Runtime.hs +16/−16
• src/Data/Record/Plugin/Runtime.hs +18/−9

@@ -1,5 +1,9 @@ # Revision history for large-records +## 0.2.1.0 -- 2022-04-06++* Update for `large-generics` 0.2+ ## 0.2.0.0 -- 2022-03-23   * Avoid all quotes: no more Template Haskell (#63) or quasi-quotes (#43).

@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               large-records-version:            0.2.0.0+version:            0.2.1.0 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@@ -46,10 +46,12 @@       base             >= 4.13   && < 4.17     , containers       >= 0.6.2  && < 0.7     , mtl              >= 2.2.1  && < 2.3+    , primitive        >= 0.7    && < 0.8     , record-hasfield  >= 1.0    && < 1.1     , syb              >= 0.7    && < 0.8-    , vector           >= 0.12   && < 0.13-    , large-generics   >= 0.1    && < 0.2++      -- large-generics 0.2 starts using 'SmallArray' instead of 'Vector'+    , large-generics   >= 0.2    && < 0.3        -- transformers 0.5.6 introduces Writer.CPS     , transformers     >= 0.5.6  && < 0.7

@@ -85,7 +85,7 @@ -- -- TODO: From ghc 9.2 and up, we should generate ----- > newtype T a b = TFromVector {vectorFromT :: Vector Any}+-- > newtype T a b = TFromVector {vectorFromT :: SmallArray Any} -- >   deriving anyclass C -- where applicable -- -- instead, along with a pattern synonym.@@ -122,14 +122,14 @@     fieldExistentialType :: LRdrName -> Field -> (LRdrName, LHsType GhcPs)     fieldExistentialType var fld = (fieldName fld, optionalBang $ VarT var) --- | Generate conversion to and from vector+-- | Generate conversion to and from an array -- -- Generates something like ----- > vectorFromT :: T a b -> Vector Any+-- > vectorFromT :: T a b -> SmallArray Any -- > vectorFromT = \x -> -- >     case x of--- >       MkT f0 f1 f2 f3 f4 -> V.fromList [+-- >       MkT f0 f1 f2 f3 f4 -> smallArrayFromList [ -- >           unsafeCoerce f0 -- >         , unsafeCoerce f1 -- >         , unsafeCoerce f2@@ -137,9 +137,9 @@ -- >         , unsafeCoerce f4 -- >         ] -- >--- > vectorToT :: Vector Any -> T a b+-- > vectorToT :: SmallArray Any -> T a b -- > vectorToT = \x ->--- >     case V.toList x of+-- >     case smallArrayToList x of -- >       [f0, f1, f2, f3, f4] -> -- >         MkT (unsafeCoerce f0) -- >             (unsafeCoerce f1)@@ -163,11 +163,11 @@             sigD name $               funT                 (recordTypeT r)-                (ConT RT.type_Vector `appT` ConT RT.type_Any)+                (ConT RT.type_SmallArray `appT` ConT RT.type_Any)           , valD name $               lamE1 (conP recordConName (map varP args)) $                 appE-                  (VarE RT.fromList)+                  (VarE RT.smallArrayFromList)                   (listE [ VarE RT.unsafeCoerce `appE` VarE arg                          | arg <- args                          ]@@ -184,12 +184,12 @@         return $ [             sigD name $               funT-                (ConT RT.type_Vector `appT` ConT RT.type_Any)+                (ConT RT.type_SmallArray `appT` ConT RT.type_Any)                 (recordTypeT r)           , valD name $               lamE1 (varP x) $                 caseE-                  (VarE RT.toList `appE` VarE x)+                  (VarE RT.smallArrayToList `appE` VarE x)                   [ ( listP (map varP args)                     , appsE                         (ConE recordConName)@@ -244,7 +244,7 @@             appE               (VarE RT.noInlineUnsafeCo)               (appsE-                 (VarE RT.unsafeIndex)+                 (VarE RT.indexSmallArray)                  [ VarE (nameVectorFrom r) `appE` VarE t                  , VarE n                  ]@@ -281,7 +281,7 @@             appE               (VarE (nameVectorTo r))               (appsE-                 (VarE RT.unsafeUpd)+                 (VarE RT.updateSmallArray)                  [ VarE (nameVectorFrom r) `appE` VarE t                  , listE [                        tupE $@@ -419,7 +419,10 @@       lamE1 (varP p) $         appE           (ConE RT.con_Rep)-          (VarE RT.fromList `appE` listE (map (dictForField p) recordFields))+          (appE+             (VarE RT.smallArrayFromList)+             (listE (map (dictForField p) recordFields))+          )   where     dictForField :: LRdrName -> Field -> LHsExpr GhcPs     dictForField p Field{..} =@@ -483,7 +486,10 @@             , ( RT.recordFieldMetadata               , appE                   (ConE RT.con_Rep)-                  (VarE RT.fromList `appE` listE (map auxField recordFields))+                  (appE+                     (VarE RT.smallArrayFromList)+                     (listE (map auxField recordFields))+                  )               )             ]   where

@@ -17,12 +17,12 @@   , unq_showsPrec   , error   , unsafeCoerce-    -- * vector-  , type_Vector-  , fromList-  , toList-  , unsafeIndex-  , unsafeUpd+    -- * primitive+  , type_SmallArray+  , smallArrayFromList+  , smallArrayToList+  , indexSmallArray+  , updateSmallArray     -- * record-hasfield   , type_HasField   , unq_hasField@@ -105,18 +105,18 @@   vector -------------------------------------------------------------------------------} -type_Vector :: LRdrName-type_Vector = nameQT "Vector"+type_SmallArray :: LRdrName+type_SmallArray = nameQT "SmallArray" -fromList    :: LRdrName-toList      :: LRdrName-unsafeIndex :: LRdrName-unsafeUpd   :: LRdrName+smallArrayFromList :: LRdrName+smallArrayToList   :: LRdrName+indexSmallArray    :: LRdrName+updateSmallArray   :: LRdrName -fromList    = nameQV "fromList"-toList      = nameQV "toList"-unsafeIndex = nameQV "unsafeIndex"-unsafeUpd   = nameQV "unsafeUpd"+smallArrayFromList = nameQV "smallArrayFromList"+smallArrayToList   = nameQV "smallArrayToList"+indexSmallArray    = nameQV "indexSmallArray"+updateSmallArray   = nameQV "updateSmallArray"  {-------------------------------------------------------------------------------   record-hasfield

@@ -19,11 +19,11 @@   , unsafeCoerce   , error     -- * vector-  , Vector-  , Vector.fromList-  , Vector.toList-  , Vector.unsafeIndex-  , Vector.unsafeUpd+  , SmallArray+  , smallArrayFromList+  , smallArrayToList+  , indexSmallArray+  , updateSmallArray     -- * record-hasfield   , GRC.HasField(hasField)     -- * large-generics@@ -44,19 +44,20 @@   , repToVector   ) where +import Control.Monad (forM_) import Data.Coerce (coerce) import Data.Kind (Constraint, Type)+import Data.Primitive.SmallArray import Data.Proxy (Proxy(Proxy))-import Data.Vector (Vector) import GHC.Exts (Any) import Unsafe.Coerce (unsafeCoerce) +import qualified Data.Foldable                    as Foldable import qualified Data.Record.Generic              as LR import qualified Data.Record.Generic.Eq           as LR import qualified Data.Record.Generic.GHC          as LR import qualified Data.Record.Generic.Rep.Internal as LR import qualified Data.Record.Generic.Show         as LR-import qualified Data.Vector                      as Vector import qualified GHC.Records.Compat               as GRC  {-------------------------------------------------------------------------------@@ -66,10 +67,18 @@ dictFor :: c x => Proxy c -> Proxy x -> LR.Dict c x dictFor _ _ = LR.Dict -repFromVector :: Vector Any -> LR.Rep LR.I a+repFromVector :: SmallArray Any -> LR.Rep LR.I a repFromVector = coerce -repToVector :: LR.Rep LR.I a -> Vector Any+repToVector :: LR.Rep LR.I a -> SmallArray Any repToVector = coerce +smallArrayToList :: SmallArray a -> [a]+smallArrayToList = Foldable.toList +updateSmallArray :: SmallArray a -> [(Int, a)] -> SmallArray a+updateSmallArray v updates = runSmallArray $ do+    v' <- thawSmallArray v 0 (sizeofSmallArray v)+    forM_ updates $ \(i, a) -> do+      writeSmallArray v' i a+    return v'