ref: a4229eb282ca32bc14103a33092e94382c3c7ca0
parent: 51f905138babfc67f3291a40c8b5ddd7ec85b73d
author: Lennart Augustsson <lennart@augustsson.net>
date: Mon Jan 6 07:22:08 EST 2025
Force the compile cache on save.
--- a/src/MicroHs/CompileCache.hs
+++ b/src/MicroHs/CompileCache.hs
@@ -11,6 +11,7 @@
import MicroHs.Expr(IdentModule)
import MicroHs.Ident(showIdent)
import qualified MicroHs.IdentMap as M
+import MicroHs.MRnf
import MicroHs.Package
import MicroHs.TypeCheck(TModule, tModuleName, GlobTables, emptyGlobTables, mergeGlobTables)
import System.IO
@@ -29,6 +30,10 @@
(TModule [LDef]) -- the cached module
-- deriving (Show)
+instance MRnf CacheEntry where
+ mrnf (CompMdl a b c) = mrnf a `seq` mrnf b `seq` mrnf c
+ mrnf (PkgMdl a) = mrnf a
+
tModuleOf :: CacheEntry -> TModule [LDef]
tModuleOf (CompMdl t _ _) = t
tModuleOf (PkgMdl t) = t
@@ -46,6 +51,12 @@
}
-- deriving (Show)
+instance MRnf Cache where
+ mrnf (Cache a b c d e) = mrnf a `seq` mrnf b `seq` mrnf c `seq` mrnf d `seq` mrnf e
+
+forceCache :: Cache -> Cache
+forceCache c = mrnf c `seq` c
+
getCacheTables :: Cache -> GlobTables
getCacheTables = tables
@@ -114,7 +125,7 @@
where ins t = M.insert (tModuleName t) (PkgMdl t)
saveCache :: FilePath -> Cache -> IO ()
-saveCache fn cash = writeSerializedCompressed fn cash
+saveCache fn cash = writeSerializedCompressed fn (forceCache cash)
loadCached :: FilePath -> IO (Maybe Cache)
loadCached fn = do
--- /dev/null
+++ b/src/MicroHs/MRnf.hs
@@ -1,0 +1,34 @@
+module MicroHs.MRnf where
+import Prelude(); import MHSPrelude
+import Data.Text
+import Data.Version
+import System.IO.MD5(MD5CheckSum)
+
+class MRnf a where
+ mrnf :: a -> ()
+ mrnf a = seq a ()
+
+instance MRnf Int
+instance MRnf Char
+instance (MRnf a, MRnf b) => MRnf (a, b) where
+ mrnf (a, b) = mrnf a `seq` mrnf b
+instance (MRnf a, MRnf b) => MRnf (Either a b) where
+ mrnf (Left a) = mrnf a
+ mrnf (Right a) = mrnf a
+instance MRnf a => MRnf [a] where
+ mrnf [] = ()
+ mrnf (x:xs) = mrnf x `seq` mrnf xs
+instance MRnf a => MRnf (Maybe a) where
+ mrnf Nothing = ()
+ mrnf (Just x) = mrnf x
+instance MRnf Text
+instance MRnf Version where
+ mrnf v = mrnf (versionBranch v)
+instance MRnf Rational where
+ mrnf x = (x == 0) `seq` ()
+instance MRnf Double
+instance MRnf Integer where
+ mrnf x = (x == 0) `seq` ()
+instance MRnf Bool
+instance MRnf (a -> b)
+instance MRnf MD5CheckSum -- Not quite NF, but close