runModularPipeline

app/App.hs

@@ -2,13 +2,21 @@ module App where
 
 import CommonOptions
 import Data.ByteString qualified as ByteString
+import Data.HashMap.Strict qualified as HashMap
 import GlobalOptions
 import Juvix.Compiler.Backend.Markdown.Error
+import Juvix.Compiler.Core.Data.Module qualified as Core
+import Juvix.Compiler.Core.Translation.FromInternal.Data.Context qualified as Core
 import Juvix.Compiler.Internal.Translation (InternalTypedResult)
 import Juvix.Compiler.Internal.Translation.FromInternal.Analysis.Termination.Checker
+import Juvix.Compiler.Pipeline qualified as Pipeline
 import Juvix.Compiler.Pipeline.Loader.PathResolver
+import Juvix.Compiler.Pipeline.Modular (ModularEff)
+import Juvix.Compiler.Pipeline.Modular.Run qualified as Pipeline.Modular
 import Juvix.Compiler.Pipeline.Root
 import Juvix.Compiler.Pipeline.Run
+import Juvix.Compiler.Store.Extra qualified as Store
+import Juvix.Compiler.Store.Language qualified as Store
 import Juvix.Data.Error qualified as Error
 import Juvix.Data.SHA256 qualified as SHA256
 import Juvix.Extra.Paths.Base hiding (rootBuildDir)
@@ -177,15 +185,23 @@ getEntryPoint' RunAppIOArgs {..} inputFile = do
     . set entryPointStdin estdin
     <$> entryPointFromGlobalOptionsPre root ((^. pathPath) <$> mainFile) opts
 
+getEntryPoint'' ::
+  (Members '[App, EmbedIO, TaggedLock] r, EntryPointOptions opts) =>
+  opts ->
+  Maybe (AppPath File) ->
+  Sem r EntryPoint
+getEntryPoint'' opts inputFile = do
+  args <- askArgs
+  applyOptions opts <$> getEntryPoint' args inputFile
+
 runPipelineEither ::
   (Members '[EmbedIO, TaggedLock, Logger, App] r, EntryPointOptions opts) =>
   opts ->
   Maybe (AppPath File) ->
   Sem (PipelineEff r) a ->
   Sem r (Either JuvixError (ResolverState, PipelineResult a))
 runPipelineEither opts input_ p = runPipelineOptions $ do
-  args <- askArgs
-  entry <- applyOptions opts <$> getEntryPoint' args input_
+  entry <- getEntryPoint'' opts input_
   runIOEither entry (inject p)
 
 getEntryPointStdin' :: (Members '[EmbedIO, TaggedLock] r) => RunAppIOArgs -> Sem r EntryPoint
@@ -335,6 +351,26 @@ runPipelineSetup p = do
   r <- runIOEitherPipeline entry (inject p) >>= fromRightJuvixError
   return (snd r)
 
+runPipelineModular ::
+  forall a r opts.
+  (Members '[App, EmbedIO, Logger, TaggedLock] r, EntryPointOptions opts) =>
+  opts ->
+  Maybe (AppPath File) ->
+  (Core.ModuleTable -> Sem (ModularEff r) a) ->
+  Sem r a
+runPipelineModular opts input_ f = runPipelineOptions $ do
+  entry <- getEntryPoint'' opts input_
+  let p :: Sem (PipelineEff r) Core.CoreResult = Pipeline.upToStoredCore
+  r <- runIOEither entry (inject p) >>= fromRightJuvixError
+  let res = snd r
+      md = res ^. pipelineResult . Core.coreResultModule
+      mtab =
+        over Core.moduleTable (HashMap.insert (md ^. Core.moduleId) md)
+          . Store.toCoreModuleTable (res ^. pipelineResultImportTables)
+          . HashMap.elems
+          $ res ^. pipelineResultImports . Store.moduleTable
+  Pipeline.Modular.runIOEitherPipeline entry (inject (f mtab)) >>= fromRightJuvixError
+
 renderStdOutLn :: forall a r. (Member App r, HasAnsiBackend a, HasTextBackend a) => a -> Sem r ()
 renderStdOutLn txt = renderStdOut txt >> newline
 

src/Juvix/Compiler/Core/Data/Module/Base.hs

@@ -61,7 +61,7 @@ lookupModuleTable mt mid =
   fromMaybe (impossibleError ("Could not find module " <> prettyText mid)) (lookupModuleTable' mt mid)
 
 computeImportsTable :: (Monoid t) => ModuleTable' t -> [ModuleId] -> t
-computeImportsTable mt = foldMap ((^. moduleImportsTable) . lookupModuleTable mt)
+computeImportsTable mt = foldMap (computeCombinedInfoTable . lookupModuleTable mt)
 
 updateImportsTable :: (Monoid t) => ModuleTable' t -> Module' t -> Module' t
 updateImportsTable mt m =

src/Juvix/Compiler/Pipeline/Driver.hs

@@ -46,6 +46,7 @@ import Juvix.Compiler.Pipeline.JvoCache
 import Juvix.Compiler.Pipeline.Loader.PathResolver
 import Juvix.Compiler.Pipeline.ModuleInfoCache
 import Juvix.Compiler.Store.Core.Extra
+import Juvix.Compiler.Store.Core.Extra qualified as Store
 import Juvix.Compiler.Store.Extra
 import Juvix.Compiler.Store.Extra qualified as Store
 import Juvix.Compiler.Store.Language
@@ -250,6 +251,7 @@ processModuleCacheMissDecide entryIx = do
                 PipelineResult
                   { _pipelineResult = info,
                     _pipelineResultImports = _compileResultModuleTable,
+                    _pipelineResultImportTables = _compileResultImportTables,
                     _pipelineResultChanged = False
                   }
 
@@ -492,11 +494,12 @@ processFileUpToParsing ::
 processFileUpToParsing entry = do
   res <- runReader entry upToParsing
   let imports :: [Import 'Parsed] = res ^. Parser.resultParserState . Parser.parserStateImports
-  mtab <- (^. compileResultModuleTable) <$> runReader entry (processImports (map (^. importModulePath) imports))
+  CompileResult {..} <- runReader entry (processImports (map (^. importModulePath) imports))
   return
     PipelineResult
       { _pipelineResult = res,
-        _pipelineResultImports = mtab,
+        _pipelineResultImports = _compileResultModuleTable,
+        _pipelineResultImportTables = _compileResultImportTables,
         _pipelineResultChanged = True
       }
 
@@ -528,11 +531,25 @@ processImports imports = do
         Store.mkModuleTable (map (^. pipelineResult) ms)
           <> mconcatMap (^. pipelineResultImports) ms
       changed = any (^. pipelineResultChanged) ms
+      itabs =
+        HashMap.fromList
+          . map computeImportsTable
+          $ ms
   return
     CompileResult
       { _compileResultChanged = changed,
-        _compileResultModuleTable = mtab
+        _compileResultModuleTable = mtab,
+        _compileResultImportTables = itabs
       }
+  where
+    computeImportsTable :: PipelineResult Store.ModuleInfo -> (ModuleId, Core.InfoTable)
+    computeImportsTable r =
+      ( mid,
+        Store.toCore (r ^. pipelineResult . Store.moduleInfoCoreTable)
+          <> mconcat (HashMap.elems (r ^. pipelineResultImportTables))
+      )
+      where
+        mid = r ^. pipelineResult . Store.moduleInfoInternalModule . Internal.internalModuleId
 
 processModuleToStoredCore ::
   forall r.

src/Juvix/Compiler/Pipeline/Driver/Data.hs

@@ -4,6 +4,7 @@ module Juvix.Compiler.Pipeline.Driver.Data
   )
 where
 
+import Juvix.Compiler.Core.Data.InfoTable qualified as Core
 import Juvix.Compiler.Pipeline.Loader.PathResolver.ImportTree.Base
 import Juvix.Compiler.Pipeline.Result
 import Juvix.Compiler.Store.Language
@@ -14,6 +15,7 @@ import Prelude (show)
 
 data CompileResult = CompileResult
   { _compileResultModuleTable :: Store.ModuleTable,
+    _compileResultImportTables :: HashMap ModuleId Core.InfoTable,
     _compileResultChanged :: Bool
   }
 
@@ -33,14 +35,16 @@ instance Semigroup CompileResult where
   sconcat l =
     CompileResult
       { _compileResultChanged = any (^. compileResultChanged) l,
-        _compileResultModuleTable = sconcatMap (^. compileResultModuleTable) l
+        _compileResultModuleTable = sconcatMap (^. compileResultModuleTable) l,
+        _compileResultImportTables = sconcatMap (^. compileResultImportTables) l
       }
 
 instance Monoid CompileResult where
   mempty =
     CompileResult
       { _compileResultChanged = False,
-        _compileResultModuleTable = mempty
+        _compileResultModuleTable = mempty,
+        _compileResultImportTables = mempty
       }
 
 data ProcessModuleDecision (r :: [Effect])

src/Juvix/Compiler/Pipeline/Modular.hs

@@ -1,5 +1,6 @@
 module Juvix.Compiler.Pipeline.Modular where
 
+import Data.List.Singletons (type (++))
 import Juvix.Compiler.Core.Data.Module qualified as Core
 import Juvix.Compiler.Core.Data.Module.Base
 import Juvix.Compiler.Core.Data.TransformationId qualified as Core
@@ -13,6 +14,14 @@ import Juvix.Extra.Serialize qualified as Serialize
 import Juvix.Prelude
 import Path qualified
 
+type ModularEff r =
+  '[ Files,
+     TaggedLock,
+     Reader EntryPoint,
+     Error JuvixError
+   ]
+    ++ r
+
 processModule ::
   (Members '[Files, Error JuvixError, Reader EntryPoint, ModuleCache (Module' t)] r) =>
   ModuleId ->
@@ -87,23 +96,23 @@ processImports mids = do
         _pipelineResultChanged = any (^. pipelineResultChanged) res
       }
 
-runModularPipeline ::
+processModuleTable ::
   forall t t' r.
   (Serialize t', Monoid t', Members '[Files, TaggedLock, Error JuvixError, Reader EntryPoint] r) =>
-  (forall r'. (Members '[Error JuvixError, Reader EntryPoint] r') => Module' t -> Sem r' (Module' t')) ->
+  (Module' t -> Sem r (Module' t')) ->
   ModuleTable' t ->
   Sem r (ModuleTable' t')
-runModularPipeline f mt = do
+processModuleTable f mt = do
   tab <-
     evalCacheEmpty
-      (processModuleCacheMiss mt f)
+      (processModuleCacheMiss mt (inject . f))
       $ mapM (fmap (^. pipelineResult) . processModule . (^. moduleId)) (mt ^. moduleTable)
   return $ ModuleTable tab
 
-runModularStoredCoreToTree ::
+modularCoreToTree ::
   (Members '[Files, TaggedLock, Error JuvixError, Reader EntryPoint] r) =>
   Core.TransformationId ->
   Core.ModuleTable ->
   Sem r Tree.ModuleTable
-runModularStoredCoreToTree checkId mt =
-  runModularPipeline (Pipeline.storedCoreToTree checkId) mt
+modularCoreToTree checkId mt =
+  processModuleTable (Pipeline.storedCoreToTree checkId) mt

src/Juvix/Compiler/Pipeline/Modular/Run.hs

@@ -0,0 +1,19 @@
+module Juvix.Compiler.Pipeline.Modular.Run where
+
+import Juvix.Compiler.Concrete.Data.Highlight
+import Juvix.Compiler.Pipeline.EntryPoint
+import Juvix.Compiler.Pipeline.Modular
+import Juvix.Prelude
+
+runIOEitherPipeline ::
+  forall a r.
+  (Members '[TaggedLock, EmbedIO] r) =>
+  EntryPoint ->
+  Sem (ModularEff r) a ->
+  Sem r (Either JuvixError a)
+runIOEitherPipeline entry a =
+  evalHighlightBuilder
+    . runJuvixError
+    . runReader entry
+    . runFilesIO
+    $ inject a

src/Juvix/Compiler/Pipeline/Result.hs

@@ -1,5 +1,6 @@
 module Juvix.Compiler.Pipeline.Result where
 
+import Juvix.Compiler.Core.Data.InfoTable qualified as Core
 import Juvix.Compiler.Store.Language qualified as Store
 import Juvix.Prelude
 
@@ -10,6 +11,9 @@ data PipelineResult a = PipelineResult
     -- then still both A and B will be in the imports table in the pipeline
     -- result for processing M.
     _pipelineResultImports :: Store.ModuleTable,
+    -- | Core imports table for every transitive import stored in
+    -- _pipelineResultImports.
+    _pipelineResultImportTables :: HashMap ModuleId Core.InfoTable,
     -- | True if the module had to be recompiled. False if the module was loaded
     -- from disk.
     _pipelineResultChanged :: Bool

src/Juvix/Compiler/Store/Extra.hs

@@ -4,6 +4,7 @@ import Data.HashMap.Strict qualified as HashMap
 import Juvix.Compiler.Concrete.Data.Name qualified as C
 import Juvix.Compiler.Concrete.Data.ScopedName qualified as S
 import Juvix.Compiler.Core.Data.InfoTable qualified as Core
+import Juvix.Compiler.Core.Data.Module qualified as Core
 import Juvix.Compiler.Store.Core.Extra
 import Juvix.Compiler.Store.Internal.Language
 import Juvix.Compiler.Store.Language
@@ -52,3 +53,23 @@ computeCombinedBuiltins mtab =
   mconcatMap
     (^. moduleInfoScopedModule . scopedModuleInfoTable . infoBuiltins)
     (HashMap.elems (mtab ^. moduleTable))
+
+toCoreModuleTable :: HashMap ModuleId Core.InfoTable -> [ModuleInfo] -> Core.ModuleTable
+toCoreModuleTable imports modules =
+  Core.ModuleTable
+    . HashMap.fromList
+    . map (\md -> (md ^. Core.moduleId, md))
+    . map (toCoreModule imports)
+    $ modules
+
+toCoreModule :: HashMap ModuleId Core.InfoTable -> ModuleInfo -> Core.Module
+toCoreModule imports ModuleInfo {..} =
+  Core.Module
+    { _moduleId = mid,
+      _moduleInfoTable = toCore _moduleInfoCoreTable,
+      _moduleImports = _moduleInfoInternalModule ^. internalModuleImports,
+      _moduleImportsTable = fromJust $ HashMap.lookup mid imports,
+      _moduleSHA256 = Just _moduleInfoSHA256
+    }
+  where
+    mid = _moduleInfoInternalModule ^. internalModuleId

src/Juvix/Compiler/Store/Scoped/Language.hs

@@ -64,9 +64,6 @@ exportAllNames =
 createExportsTable :: ExportInfo -> HashSet NameId
 createExportsTable = HashSet.fromList . (^.. exportAllNames . S.nameId)
 
-getScopedModuleNameId :: ScopedModule -> S.NameId
-getScopedModuleNameId m = m ^. scopedModuleName . S.nameId
-
 getCombinedInfoTable :: ScopedModule -> InfoTable
 getCombinedInfoTable sm = sm ^. scopedModuleInfoTable <> mconcatMap getCombinedInfoTable (sm ^. scopedModuleLocalModules)