add BangPatterns to atom values

there should never be a case where the thunk for the atom value is useful this cuts out unnecessary pointer direction in a 200000 arbitrary Int+Text relation by 10% measured 2x memory overhead for this basic relvar
agentm · Dec 12, 2021 · 0b008ba · 0b008ba
1 parent 08bab65
commit 0b008ba
Show file tree

Hide file tree

Showing 2 changed files with 32 additions and 28 deletions.
diff --git a/project-m36.cabal b/project-m36.cabal
@@ -35,7 +35,7 @@ Flag haskell-scripting
      Default: True
 
 Library
-    Build-Depends: base>=4.8 && < 4.15, ghc-paths, mtl, containers, unordered-containers, hashable, haskeline, directory, MonadRandom, random-shuffle, uuid >= 1.3.12, cassava >= 0.4.5.1 && < 0.6, text, bytestring, deepseq, deepseq-generics, vector, parallel, monad-parallel, exceptions, transformers, gnuplot, filepath, zlib, directory, temporary, stm, time, hashable-time, old-locale, rset, attoparsec, either, base64-bytestring, data-interval, extended-reals, aeson >= 1.1, path-pieces, conduit, resourcet, http-api-data, semigroups, QuickCheck, quickcheck-instances, list-t, stm-containers >= 0.2.15, foldl, optparse-applicative, Glob, cryptohash-sha256, text-manipulate >= 0.2.0.1 && < 0.4, winery, curryer-rpc, network, async, vector-instances, recursion-schemes, streamly >= 0.7.2, convertible
+    Build-Depends: base>=4.8 && < 4.15, ghc-paths, mtl, containers, unordered-containers, hashable, haskeline, directory, MonadRandom, random-shuffle, uuid >= 1.3.12, cassava >= 0.4.5.1 && < 0.6, text, bytestring, deepseq, deepseq-generics, vector, parallel, monad-parallel, exceptions, transformers, gnuplot, filepath, zlib, directory, temporary, stm, time, hashable-time, old-locale, rset, attoparsec, either, base64-bytestring, data-interval, extended-reals, aeson >= 1.1, path-pieces, conduit, resourcet, http-api-data, semigroups, QuickCheck, quickcheck-instances, list-t, stm-containers >= 0.2.15, foldl, optparse-applicative, Glob, cryptohash-sha256, text-manipulate >= 0.2.0.1 && < 0.4, winery, curryer-rpc, network, async, vector-instances, recursion-schemes, streamly >= 0.7.2, convertible, fast-builder
     if flag(haskell-scripting)
         Build-Depends: ghc >= 8.2 && < 8.11
         CPP-Options: -DPM36_HASKELL_SCRIPTING
@@ -130,22 +130,23 @@ Library
                      ProjectM36.GraphRefRelationalExpr,
                      ProjectM36.NormalizeExpr,
                      ProjectM36.TransactionInfo,
-                     ProjectM36.WithNameExpr
+                     ProjectM36.WithNameExpr, 
+                     ProjectM36.Trace
     GHC-Options: -Wall -rdynamic
     if os(windows)
       Build-Depends: Win32 >= 2.5.4.1
       Other-Modules: ProjectM36.Win32Handle
     else
       --219-  too many exported symbols under Windows and GHC 8.4
-      GHC-Options: -rdynamic -fexternal-interpreter
+      GHC-Options: -rdynamic -fexternal-interpreter -eventlog
       C-sources: cbits/DirectoryFsync.c, cbits/darwin_statfs.c
       Build-Depends: unix
     CC-Options: -fPIC
     Hs-Source-Dirs: ./src/lib
     Default-Language: Haskell2010
     Default-Extensions: OverloadedStrings, CPP
     if !flag(stack)
-      Build-Depends: deferred-folds
+      Build-Depends: deferred-folds 
 
 Executable tutd
     if flag(haskell-scripting)
@@ -215,9 +216,11 @@ Executable tutd
     main-is: TutorialD/tutd.hs
     CC-Options: -fPIC
     if os(windows)
-      GHC-Options: -Wall -threaded
+      GHC-Options: -Wall -threaded -eventlog -rtsopts
     else
-      GHC-Options: -Wall -threaded -rdynamic
+      GHC-Options: -Wall -threaded -rdynamic -eventlog -rtsopts
+    if flag(profiler)
+      GHC-Prof-Options: -fprof-auto -rtsopts -threaded -prof
     Hs-Source-Dirs: ./src/bin
     Default-Language: Haskell2010
     Default-Extensions: OverloadedStrings
@@ -256,7 +259,7 @@ Executable project-m36-server
     if os(windows)
       GHC-Options: -Wall -threaded -rtsopts
     else
-      GHC-Options: -Wall -threaded -rtsopts -rdynamic      
+      GHC-Options: -Wall -threaded -rtsopts -rdynamic
     if flag(profiler)
       GHC-Prof-Options: -fprof-auto -rtsopts -threaded -Wall
     Default-Language: Haskell2010
@@ -274,7 +277,7 @@ Executable bigrel
     GHC-Options: -Wall -threaded -rtsopts
     HS-Source-Dirs: ./src/bin
     if flag(profiler)
-      GHC-Prof-Options: -fprof-auto -rtsopts -threaded -Wall
+      GHC-Prof-Options: -fprof-auto -rtsopts -threaded -Wall -eventlog
 
 Common commontest
     Default-Language: Haskell2010

diff --git a/src/lib/ProjectM36/Base.hs b/src/lib/ProjectM36/Base.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE ExistentialQuantification,DeriveGeneric,DeriveAnyClass,FlexibleInstances,OverloadedStrings, DeriveTraversable, DerivingVia, TemplateHaskell, TypeFamilies #-}
+{-# LANGUAGE ExistentialQuantification,DeriveGeneric,DeriveAnyClass,FlexibleInstances,OverloadedStrings, DeriveTraversable, DerivingVia, TemplateHaskell, TypeFamilies, BangPatterns #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module ProjectM36.Base where
@@ -44,18 +44,18 @@ instance Hashable (S.Set AttributeName) where
 #endif
 
 -- | Database atoms are the smallest, undecomposable units of a tuple. Common examples are integers, text, or unique identity keys.
-data Atom = IntegerAtom Integer |
-            IntAtom Int |
-            DoubleAtom Double |
-            TextAtom Text |
-            DayAtom Day |
-            DateTimeAtom UTCTime |
-            ByteStringAtom ByteString |
-            BoolAtom Bool |
-            UUIDAtom UUID |
-            RelationAtom Relation |
-            RelationalExprAtom RelationalExpr | --used for returning inc deps
-            ConstructedAtom DataConstructorName AtomType [Atom]
+data Atom = IntegerAtom !Integer |
+            IntAtom !Int |
+            DoubleAtom !Double |
+            TextAtom !Text |
+            DayAtom !Day |
+            DateTimeAtom !UTCTime |
+            ByteStringAtom !ByteString |
+            BoolAtom !Bool |
+            UUIDAtom !UUID |
+            RelationAtom !Relation |
+            RelationalExprAtom !RelationalExpr | --used for returning inc deps
+            ConstructedAtom !DataConstructorName !AtomType [Atom]
             deriving (Eq, Show, Typeable, NFData, Generic, Read)
 
 instance Hashable Atom where                     
@@ -579,19 +579,20 @@ instance Eq (Function a) where
   f1 == f2 = funcName f1 == funcName f2
 
 instance Hashable (Function a) where
-  hashWithSalt salt func = salt `hashWithSalt` funcName func `hashWithSalt` funcType func `hashWithSalt` funcBody func
-
+  hashWithSalt salt func = salt `hashWithSalt` funcName func `hashWithSalt` funcType func `hashWithSalt` hashfuncbody 
+   where
+    hashfuncbody =
+      case funcBody func of
+        (FunctionScriptBody script _) -> salt `hashWithSalt` script
+        (FunctionBuiltInBody _) -> salt
+        (FunctionObjectLoadedBody fp modName entryFunc _) -> salt `hashWithSalt` (fp, modName, entryFunc)
+
 data FunctionBody a =
   FunctionScriptBody FunctionBodyScript a |
   FunctionBuiltInBody a |
   FunctionObjectLoadedBody FilePath ObjectModuleName ObjectFileEntryFunctionName a
   deriving Generic
 
-instance Hashable (FunctionBody a) where
-  salt `hashWithSalt` (FunctionScriptBody script _) = salt `hashWithSalt` script
-  salt `hashWithSalt` (FunctionBuiltInBody _) = salt
-  salt `hashWithSalt` (FunctionObjectLoadedBody fp modName entryFunc _) = salt `hashWithSalt` (fp, modName, entryFunc)
-
 instance NFData a => NFData (FunctionBody a) where
   rnf (FunctionScriptBody script _) = rnf script
   rnf (FunctionBuiltInBody _) = rnf ()