refactor

anoma · Aug 22, 2024 · 9d05d5c · 9d05d5c
1 parent 2b4520c
commit 9d05d5c
Show file tree

Hide file tree

Showing 4 changed files with 62 additions and 30 deletions.
diff --git a/src/Juvix/Compiler/Pipeline/Driver.hs b/src/Juvix/Compiler/Pipeline/Driver.hs
@@ -40,6 +40,7 @@ import Juvix.Compiler.Store.Core.Extra
 import Juvix.Compiler.Store.Extra qualified as Store
 import Juvix.Compiler.Store.Language
 import Juvix.Compiler.Store.Language qualified as Store
+import Juvix.Compiler.Store.Options
 import Juvix.Compiler.Store.Options qualified as StoredModule
 import Juvix.Compiler.Store.Options qualified as StoredOptions
 import Juvix.Data.CodeAnn
@@ -70,7 +71,13 @@ evalModuleInfoCacheSetup ::
   Sem r a
 evalModuleInfoCacheSetup setup = evalJvoCache . evalCacheEmptySetup setup processModuleCacheMiss
 
-processModuleCacheMiss ::
+reuseJvoCondition :: Store.ModuleInfo -> Options -> Natural -> Text -> Bool
+reuseJvoCondition info opts entryFieldSize srcSha256 =
+  info ^. Store.moduleInfoSHA256 == srcSha256
+    && info ^. Store.moduleInfoOptions == opts
+    && info ^. Store.moduleInfoFieldSize == entryFieldSize
+
+processModuleCacheMissPeek ::
   forall r.
   ( Members
       '[ ModuleInfoCache,
@@ -85,8 +92,8 @@ processModuleCacheMiss ::
       r
   ) =>
   EntryIndex ->
-  Sem r (PipelineResult Store.ModuleInfo)
-processModuleCacheMiss entryIx = do
+  Sem r (Either (Sem r (PipelineResult Store.ModuleInfo)) (PipelineResult Store.ModuleInfo))
+processModuleCacheMissPeek entryIx = do
   let buildDir = resolveAbsBuildDir root (entry ^. entryPointBuildDir)
       sourcePath = fromJust (entry ^. entryPointModulePath)
       relPath =
@@ -96,35 +103,55 @@ processModuleCacheMiss entryIx = do
           $ stripProperPrefix $(mkAbsDir "/") sourcePath
       absPath = buildDir Path.</> relPath
   sha256 <- SHA256.digestFile sourcePath
-  m :: Maybe Store.ModuleInfo <- loadFromFile absPath
+  m :: Maybe Store.ModuleInfo <- loadFromJvoFile absPath
+
+  let recompile :: Sem r (PipelineResult Store.ModuleInfo)
+      recompile = do
+        res <- processModuleToStoredCore sha256 entry
+        Serialize.saveToFile absPath (res ^. pipelineResult)
+        return res
+
   case m of
     Just info
-      | info ^. Store.moduleInfoSHA256 == sha256
-          && info ^. Store.moduleInfoOptions == opts
-          && info ^. Store.moduleInfoFieldSize == entry ^. entryPointFieldSize -> do
+      | reuseJvoCondition info opts (entry ^. entryPointFieldSize) sha256 -> do
           CompileResult {..} <- runReader entry (processImports (info ^. Store.moduleInfoImports))
-          if
-              | _compileResultChanged ->
-                  recompile sha256 absPath
-              | otherwise ->
-                  return
-                    PipelineResult
-                      { _pipelineResult = info,
-                        _pipelineResultImports = _compileResultModuleTable,
-                        _pipelineResultChanged = False
-                      }
-    _ ->
-      recompile sha256 absPath
+          return $
+            if
+                | _compileResultChanged -> Left recompile
+                | otherwise ->
+                    Right
+                      PipelineResult
+                        { _pipelineResult = info,
+                          _pipelineResultImports = _compileResultModuleTable,
+                          _pipelineResultChanged = False
+                        }
+    _ -> return (Left recompile)
   where
     entry = entryIx ^. entryIxEntry
     root = entry ^. entryPointRoot
     opts = StoredModule.fromEntryPoint entry
 
-    recompile :: Text -> Path Abs File -> Sem r (PipelineResult Store.ModuleInfo)
-    recompile sha256 absPath = do
-      res <- processModuleToStoredCore sha256 entry
-      Serialize.saveToFile absPath (res ^. pipelineResult)
-      return res
+processModuleCacheMiss ::
+  forall r.
+  ( Members
+      '[ ModuleInfoCache,
+         TaggedLock,
+         HighlightBuilder,
+         TopModuleNameChecker,
+         Error JuvixError,
+         Files,
+         JvoCache,
+         PathResolver
+       ]
+      r
+  ) =>
+  EntryIndex ->
+  Sem r (PipelineResult Store.ModuleInfo)
+processModuleCacheMiss entryIx = do
+  p <- processModuleCacheMissPeek entryIx
+  case p of
+    Right r -> return r
+    Left recomp -> recomp
 
 processProject :: (Members '[ModuleInfoCache, Reader EntryPoint, Reader ImportTree] r) => Sem r [(ImportNode, PipelineResult ModuleInfo)]
 processProject = do

diff --git a/src/Juvix/Compiler/Pipeline/DriverParallel.hs b/src/Juvix/Compiler/Pipeline/DriverParallel.hs
@@ -118,7 +118,7 @@ compileInParallel = do
         CompileArgs
           { _compileArgsNodesIndex = idx,
             _compileArgsNodeName = getNodeName,
-            _compileArgsPreProcess = Just preLoadFromFile,
+            _compileArgsPreProcess = Just preLoadFromJvoFile,
             _compileArgsDependencies = mkDependencies t,
             _compileArgsNumWorkers = numWorkers,
             _compileArgsCompileNode = compileNode

diff --git a/src/Juvix/Compiler/Pipeline/JvoCache.hs b/src/Juvix/Compiler/Pipeline/JvoCache.hs
@@ -11,8 +11,12 @@ evalJvoCache :: (Members '[TaggedLock, Files] r) => Sem (JvoCache ': r) a -> Sem
 evalJvoCache = evalCacheEmpty Serialize.loadFromFile
 
 -- | Used to fill the cache in parallel
-preLoadFromFile :: (Members '[JvoCache] r) => ImportNode -> Sem r ()
-preLoadFromFile = void . fmap force . cacheGetResult @(Path Abs File) @(Maybe Store.ModuleInfo) . (^. importNodeAbsFile)
+preLoadFromJvoFile :: (Members '[JvoCache] r) => ImportNode -> Sem r ()
+preLoadFromJvoFile =
+  void
+    . fmap force
+    . cacheGetResult @(Path Abs File) @(Maybe Store.ModuleInfo)
+    . (^. importNodeAbsFile)
 
-loadFromFile :: (Members '[JvoCache] r) => Path Abs File -> Sem r (Maybe Store.ModuleInfo)
-loadFromFile = cacheGet
+loadFromJvoFile :: (Members '[JvoCache] r) => Path Abs File -> Sem r (Maybe Store.ModuleInfo)
+loadFromJvoFile = cacheGet
diff --git a/src/Parallel/ParallelTemplate.hs b/src/Parallel/ParallelTemplate.hs
@@ -34,7 +34,8 @@ data CompileArgs (s :: [Effect]) nodeId node compileProof = CompileArgs
     _compileArgsDependencies :: Dependencies nodeId,
     _compileArgsNodeName :: node -> Text,
     _compileArgsNumWorkers :: Int,
-    -- | Called on every node without any specific order
+    -- | Called concurrently on every node without any specific order before
+    -- compilation starts.
     _compileArgsPreProcess :: Maybe (nodeId -> Sem s ()),
     _compileArgsCompileNode :: node -> Sem s compileProof
   }