Per-module compilation

app/App.hs

@@ -3,9 +3,10 @@ module App where
 import CommonOptions
 import Data.ByteString qualified as ByteString
 import GlobalOptions
-import Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.PathResolver
+import Juvix.Compiler.Internal.Translation (InternalTypedResult)
 import Juvix.Compiler.Internal.Translation.FromInternal.Analysis.Termination.Checker
-import Juvix.Compiler.Pipeline.Package
+import Juvix.Compiler.Pipeline.Loader.PathResolver
+import Juvix.Compiler.Pipeline.Root
 import Juvix.Compiler.Pipeline.Run
 import Juvix.Data.Error qualified as Error
 import Juvix.Extra.Paths.Base hiding (rootBuildDir)
@@ -30,7 +31,6 @@ data App m a where
   GetMainFile :: Maybe (AppPath File) -> App m (Path Abs File)
   FromAppPathDir :: AppPath Dir -> App m (Path Abs Dir)
   RenderStdOut :: (HasAnsiBackend a, HasTextBackend a) => a -> App m ()
-  RunCorePipelineEither :: AppPath File -> App m (Either JuvixError Artifacts)
   Say :: Text -> App m ()
   SayRaw :: ByteString -> App m ()
 
@@ -76,9 +76,6 @@ reAppIO args@RunAppIOArgs {..} =
     AskInvokeDir -> return invDir
     AskPkgDir -> return (_runAppIOArgsRoot ^. rootRootDir)
     AskBuildDir -> return (resolveAbsBuildDir (_runAppIOArgsRoot ^. rootRootDir) (_runAppIOArgsRoot ^. rootBuildDir))
-    RunCorePipelineEither input -> do
-      entry <- getEntryPoint' args input
-      embed (corePipelineIOEither entry)
     Say t
       | g ^. globalOnlyErrors -> return ()
       | otherwise -> embed (putStrLn t)
@@ -129,17 +126,17 @@ getEntryPoint' RunAppIOArgs {..} inputFile = do
         | otherwise -> return Nothing
   set entryPointStdin estdin <$> entryPointFromGlobalOptionsPre root (inputFile ^. pathPath) opts
 
-runPipelineNoFileEither :: (Members '[Embed IO, TaggedLock, App] r) => Sem (PipelineEff r) a -> Sem r (Either JuvixError (ResolverState, a))
-runPipelineNoFileEither p = do
-  args <- askArgs
-  entry <- getEntryPointStdin' args
-  snd <$> runIOEither entry p
-
-runPipelineEither :: (Members '[Embed IO, TaggedLock, App] r) => AppPath File -> Sem (PipelineEff r) a -> Sem r (Either JuvixError (ResolverState, a))
+runPipelineEither :: (Members '[Embed IO, TaggedLock, App] r) => AppPath File -> Sem (PipelineEff r) a -> Sem r (Either JuvixError (ResolverState, PipelineResult a))
 runPipelineEither input p = do
   args <- askArgs
   entry <- getEntryPoint' args input
-  snd <$> runIOEither entry p
+  runIOEither entry p
+
+runPipelineSetupEither :: (Members '[Embed IO, TaggedLock, App] r) => Sem (PipelineEff' r) a -> Sem r (Either JuvixError (ResolverState, a))
+runPipelineSetupEither p = do
+  args <- askArgs
+  entry <- getEntryPointStdin' args
+  runIOEitherPipeline entry p
 
 getEntryPointStdin' :: (Members '[Embed IO, TaggedLock] r) => RunAppIOArgs -> Sem r EntryPoint
 getEntryPointStdin' RunAppIOArgs {..} = do
@@ -170,7 +167,13 @@ getEntryPoint inputFile = do
   _runAppIOArgsRoot <- askRoot
   getEntryPoint' (RunAppIOArgs {..}) inputFile
 
-runPipelineTermination :: (Members '[App, Embed IO, TaggedLock] r) => AppPath File -> Sem (Termination ': PipelineEff r) a -> Sem r a
+getEntryPointStdin :: (Members '[Embed IO, App, TaggedLock] r) => Sem r EntryPoint
+getEntryPointStdin = do
+  _runAppIOArgsGlobalOptions <- askGlobalOptions
+  _runAppIOArgsRoot <- askRoot
+  getEntryPointStdin' (RunAppIOArgs {..})
+
+runPipelineTermination :: (Members '[Embed IO, App, TaggedLock] r) => AppPath File -> Sem (Termination ': PipelineEff r) a -> Sem r (PipelineResult a)
 runPipelineTermination input p = do
   r <- runPipelineEither input (evalTermination iniTerminationState p)
   case r of
@@ -182,11 +185,32 @@ runPipeline input p = do
   r <- runPipelineEither input p
   case r of
     Left err -> exitJuvixError err
-    Right res -> return (snd res)
+    Right res -> return (snd res ^. pipelineResult)
+
+runPipelineHtml :: (Members '[App, Embed IO, TaggedLock] r) => Bool -> AppPath File -> Sem r (InternalTypedResult, [InternalTypedResult])
+runPipelineHtml bNonRecursive input =
+  if
+      | bNonRecursive -> do
+          r <- runPipeline input upToInternalTyped
+          return (r, [])
+      | otherwise -> do
+          args <- askArgs
+          entry <- getEntryPoint' args input
+          r <- runPipelineHtmlEither entry
+          case r of
+            Left err -> exitJuvixError err
+            Right res -> return res
+
+runPipelineEntry :: (Members '[App, Embed IO, TaggedLock] r) => EntryPoint -> Sem (PipelineEff r) a -> Sem r a
+runPipelineEntry entry p = do
+  r <- runIOEither entry p
+  case r of
+    Left err -> exitJuvixError err
+    Right res -> return (snd res ^. pipelineResult)
 
-runPipelineNoFile :: (Members '[App, Embed IO, TaggedLock] r) => Sem (PipelineEff r) a -> Sem r a
-runPipelineNoFile p = do
-  r <- runPipelineNoFileEither p
+runPipelineSetup :: (Members '[App, Embed IO, TaggedLock] r) => Sem (PipelineEff' r) a -> Sem r a
+runPipelineSetup p = do
+  r <- runPipelineSetupEither p
   case r of
     Left err -> exitJuvixError err
     Right res -> return (snd res)

app/Commands/Compile.hs

@@ -17,7 +17,7 @@ runCommand opts@CompileOptions {..} = do
         Compile.PipelineArg
           { _pipelineArgFile = inputFile,
             _pipelineArgOptions = opts,
-            _pipelineArgInfoTable = _coreResultTable
+            _pipelineArgModule = _coreResultModule
           }
   case _compileTarget of
     TargetNative64 -> Compile.runCPipeline arg
@@ -31,8 +31,8 @@ writeCoreFile :: (Members '[Embed IO, App, TaggedLock] r) => Compile.PipelineArg
 writeCoreFile pa@Compile.PipelineArg {..} = do
   entryPoint <- Compile.getEntry pa
   coreFile <- Compile.outputFile _pipelineArgOptions _pipelineArgFile
-  r <- runReader entryPoint $ runError @JuvixError $ Core.toEval _pipelineArgInfoTable
+  r <- runReader entryPoint $ runError @JuvixError $ Core.toStored _pipelineArgModule
   case r of
     Left e -> exitJuvixError e
-    Right tab ->
-      embed $ TIO.writeFile (toFilePath coreFile) (show $ Core.ppOutDefault (Core.disambiguateNames tab))
+    Right md ->
+      embed $ TIO.writeFile (toFilePath coreFile) (show $ Core.ppOutDefault (Core.disambiguateNames md ^. Core.moduleInfoTable))

app/Commands/Dependencies/Update.hs

@@ -1,6 +1,8 @@
 module Commands.Dependencies.Update where
 
 import Commands.Base
+import Juvix.Compiler.Pipeline.Loader.PathResolver
+import Juvix.Compiler.Pipeline.Setup
 
 runCommand :: (Members '[Embed IO, TaggedLock, App] r) => Sem r ()
-runCommand = runPipelineNoFile (upToSetup (set dependenciesConfigForceUpdateLockfile True defaultDependenciesConfig))
+runCommand = runPipelineSetup (entrySetup (set dependenciesConfigForceUpdateLockfile True defaultDependenciesConfig))

app/Commands/Dev/Core/Asm.hs

@@ -12,9 +12,9 @@ runCommand opts = do
   gopts <- askGlobalOptions
   inputFile :: Path Abs File <- fromAppPathFile sinputFile
   s' <- readFile $ toFilePath inputFile
-  tab <- getRight (mapLeft JuvixError (Core.runParserMain inputFile Core.emptyInfoTable s'))
-  r <- runReader (project @GlobalOptions @Core.CoreOptions gopts) $ runError @JuvixError $ Core.toStripped' tab
-  tab' <- Asm.fromCore . Stripped.fromCore <$> getRight r
+  tab <- getRight (mapLeft JuvixError (Core.runParserMain inputFile defaultModuleId mempty s'))
+  r <- runReader (project @GlobalOptions @Core.CoreOptions gopts) $ runError @JuvixError $ Core.toStripped' (Core.moduleFromInfoTable tab)
+  tab' <- Asm.fromCore . Stripped.fromCore . Core.computeCombinedInfoTable <$> getRight r
   if
       | project opts ^. coreAsmPrint ->
           renderStdOut (Asm.ppOutDefault tab' tab')

app/Commands/Dev/Core/Compile.hs

@@ -3,15 +3,15 @@ module Commands.Dev.Core.Compile where
 import Commands.Base
 import Commands.Dev.Core.Compile.Base
 import Commands.Dev.Core.Compile.Options
-import Juvix.Compiler.Core.Data.InfoTable qualified as Core
+import Juvix.Compiler.Core.Data.Module qualified as Core
 import Juvix.Compiler.Core.Translation.FromSource qualified as Core
 
 runCommand :: forall r. (Members '[Embed IO, App, TaggedLock] r) => CompileOptions -> Sem r ()
 runCommand opts = do
   file <- getFile
   s <- readFile (toFilePath file)
-  tab <- getRight (mapLeft JuvixError (Core.runParserMain file Core.emptyInfoTable s))
-  let arg = PipelineArg opts file tab
+  tab <- getRight (mapLeft JuvixError (Core.runParserMain file defaultModuleId mempty s))
+  let arg = PipelineArg opts file (Core.moduleFromInfoTable tab)
   case opts ^. compileTarget of
     TargetWasm32Wasi -> runCPipeline arg
     TargetNative64 -> runCPipeline arg

app/Commands/Dev/Core/Compile/Base.hs

@@ -9,13 +9,13 @@ import Juvix.Compiler.Backend qualified as Backend
 import Juvix.Compiler.Backend.C qualified as C
 import Juvix.Compiler.Backend.Geb qualified as Geb
 import Juvix.Compiler.Backend.VampIR.Translation qualified as VampIR
-import Juvix.Compiler.Core.Data.InfoTable qualified as Core
+import Juvix.Compiler.Core.Data.Module qualified as Core
 import System.FilePath (takeBaseName)
 
 data PipelineArg = PipelineArg
   { _pipelineArgOptions :: CompileOptions,
     _pipelineArgFile :: Path Abs File,
-    _pipelineArgInfoTable :: Core.InfoTable
+    _pipelineArgModule :: Core.Module
   }
 
 getEntry :: (Members '[Embed IO, App, TaggedLock] r) => PipelineArg -> Sem r EntryPoint
@@ -51,7 +51,7 @@ runCPipeline ::
   Sem r ()
 runCPipeline pa@PipelineArg {..} = do
   entryPoint <- getEntry pa
-  C.MiniCResult {..} <- getRight (run (runReader entryPoint (runError (coreToMiniC _pipelineArgInfoTable :: Sem '[Error JuvixError, Reader EntryPoint] C.MiniCResult))))
+  C.MiniCResult {..} <- getRight (run (runReader entryPoint (runError (coreToMiniC _pipelineArgModule :: Sem '[Error JuvixError, Reader EntryPoint] C.MiniCResult))))
   cFile <- inputCFile _pipelineArgFile
   embed $ TIO.writeFile (toFilePath cFile) _resultCCode
   outfile <- Compile.outputFile _pipelineArgOptions _pipelineArgFile
@@ -84,7 +84,7 @@ runGebPipeline pa@PipelineArg {..} = do
                     { _lispPackageName = fromString $ takeBaseName $ toFilePath gebFile,
                       _lispPackageEntry = "*entry*"
                     }
-  Geb.Result {..} <- getRight (run (runReader entryPoint (runError (coreToGeb spec _pipelineArgInfoTable :: Sem '[Error JuvixError, Reader EntryPoint] Geb.Result))))
+  Geb.Result {..} <- getRight (run (runReader entryPoint (runError (coreToGeb spec _pipelineArgModule :: Sem '[Error JuvixError, Reader EntryPoint] Geb.Result))))
   embed $ TIO.writeFile (toFilePath gebFile) _resultCode
 
 runVampIRPipeline ::
@@ -95,14 +95,14 @@ runVampIRPipeline ::
 runVampIRPipeline pa@PipelineArg {..} = do
   entryPoint <- getEntry pa
   vampirFile <- Compile.outputFile _pipelineArgOptions _pipelineArgFile
-  VampIR.Result {..} <- getRight (run (runReader entryPoint (runError (coreToVampIR _pipelineArgInfoTable :: Sem '[Error JuvixError, Reader EntryPoint] VampIR.Result))))
+  VampIR.Result {..} <- getRight (run (runReader entryPoint (runError (coreToVampIR _pipelineArgModule :: Sem '[Error JuvixError, Reader EntryPoint] VampIR.Result))))
   embed $ TIO.writeFile (toFilePath vampirFile) _resultCode
 
 runAsmPipeline :: (Members '[Embed IO, App, TaggedLock] r) => PipelineArg -> Sem r ()
 runAsmPipeline pa@PipelineArg {..} = do
   entryPoint <- getEntry pa
   asmFile <- Compile.outputFile _pipelineArgOptions _pipelineArgFile
-  r <- runReader entryPoint $ runError @JuvixError (coreToAsm _pipelineArgInfoTable)
+  r <- runReader entryPoint $ runError @JuvixError (coreToAsm _pipelineArgModule)
   tab' <- getRight r
   let code = Asm.ppPrint tab' tab'
   embed $ TIO.writeFile (toFilePath asmFile) code

app/Commands/Dev/Core/Eval.hs

@@ -3,14 +3,13 @@ module Commands.Dev.Core.Eval where
 import Commands.Base
 import Commands.Dev.Core.Eval.Options
 import Evaluator
-import Juvix.Compiler.Core.Data.InfoTable qualified as Core
 import Juvix.Compiler.Core.Translation.FromSource qualified as Core
 
 runCommand :: forall r. (Members '[Embed IO, App] r) => CoreEvalOptions -> Sem r ()
 runCommand opts = do
   f :: Path Abs File <- fromAppPathFile b
   s <- readFile (toFilePath f)
-  case Core.runParser f Core.emptyInfoTable s of
+  case Core.runParser f defaultModuleId mempty s of
     Left err -> exitJuvixError (JuvixError err)
     Right (tab, Just node) -> do evalAndPrint opts tab node
     Right (_, Nothing) -> return ()

app/Commands/Dev/Core/FromConcrete.hs

@@ -4,20 +4,21 @@ import Commands.Base
 import Commands.Dev.Core.FromConcrete.Options
 import Evaluator
 import Juvix.Compiler.Core.Data.InfoTable
+import Juvix.Compiler.Core.Data.Module qualified as Core
 import Juvix.Compiler.Core.Options qualified as Core
 import Juvix.Compiler.Core.Pretty qualified as Core
 import Juvix.Compiler.Core.Transformation qualified as Core
-import Juvix.Compiler.Core.Transformation.DisambiguateNames (disambiguateNames)
+import Juvix.Compiler.Core.Transformation.DisambiguateNames (disambiguateNames')
 import Juvix.Compiler.Core.Translation
 
 runCommand :: forall r. (Members '[Embed IO, TaggedLock, App] r) => CoreFromConcreteOptions -> Sem r ()
 runCommand localOpts = do
   gopts <- askGlobalOptions
-  tab <- (^. coreResultTable) <$> runPipeline (localOpts ^. coreFromConcreteInputFile) upToCore
+  md <- (^. coreResultModule) <$> runPipeline (localOpts ^. coreFromConcreteInputFile) upToCore
   path :: Path Abs File <- fromAppPathFile (localOpts ^. coreFromConcreteInputFile)
-  let r = run $ runReader (project @GlobalOptions @Core.CoreOptions gopts) $ runError @JuvixError $ Core.applyTransformations (project localOpts ^. coreFromConcreteTransformations) tab
-  tab0 :: InfoTable <- getRight r
-  let tab' :: InfoTable = if localOpts ^. coreFromConcreteNoDisambiguate then tab0 else disambiguateNames tab0
+  let r = run $ runReader (project @GlobalOptions @Core.CoreOptions gopts) $ runError @JuvixError $ Core.applyTransformations (project localOpts ^. coreFromConcreteTransformations) md
+  tab0 :: InfoTable <- Core.computeCombinedInfoTable <$> getRight r
+  let tab' :: InfoTable = if localOpts ^. coreFromConcreteNoDisambiguate then tab0 else disambiguateNames' tab0
       inInputModule :: IdentifierInfo -> Bool
       inInputModule _ | not (localOpts ^. coreFromConcreteFilter) = True
       inInputModule x = (== Just path) . (^? identifierLocation . _Just . intervalFile) $ x
@@ -40,12 +41,8 @@ runCommand localOpts = do
       goPrint :: Sem r ()
       goPrint = case localOpts ^. coreFromConcreteSymbolName of
         Just {} -> printNode (fromMaybe err (getDef selInfo))
-        Nothing -> renderStdOut (Core.ppOut localOpts printTab)
+        Nothing -> renderStdOut (Core.ppOut localOpts tab')
         where
-          printTab :: InfoTable
-          printTab
-            | localOpts ^. coreFromConcreteFilter = filterByFile path tab'
-            | otherwise = tab'
           printNode :: (Text, Core.Node) -> Sem r ()
           printNode (name, node) = do
             renderStdOut (name <> " = ")

app/Commands/Dev/Core/Normalize.hs

@@ -3,14 +3,13 @@ module Commands.Dev.Core.Normalize where
 import Commands.Base
 import Commands.Dev.Core.Normalize.Options
 import Evaluator
-import Juvix.Compiler.Core.Data.InfoTable qualified as Core
 import Juvix.Compiler.Core.Translation.FromSource qualified as Core
 
 runCommand :: forall r. (Members '[Embed IO, App] r) => CoreNormalizeOptions -> Sem r ()
 runCommand opts = do
   f :: Path Abs File <- fromAppPathFile b
   s <- readFile (toFilePath f)
-  case Core.runParser f Core.emptyInfoTable s of
+  case Core.runParser f defaultModuleId mempty s of
     Left err -> exitJuvixError (JuvixError err)
     Right (tab, Just node) -> do normalizeAndPrint opts tab node
     Right (_, Nothing) -> return ()

app/Commands/Dev/Core/Read.hs

@@ -23,10 +23,10 @@ runCommand opts = do
   gopts <- askGlobalOptions
   inputFile :: Path Abs File <- fromAppPathFile sinputFile
   s' <- readFile . toFilePath $ inputFile
-  tab <- getRight (mapLeft JuvixError (Core.runParserMain inputFile Core.emptyInfoTable s'))
-  let r = run $ runReader (project @GlobalOptions @Core.CoreOptions gopts) $ runError @JuvixError $ Core.applyTransformations (project opts ^. coreReadTransformations) tab
+  tab <- getRight (mapLeft JuvixError (Core.runParserMain inputFile defaultModuleId mempty s'))
+  let r = run $ runReader (project @GlobalOptions @Core.CoreOptions gopts) $ runError @JuvixError $ Core.applyTransformations (project opts ^. coreReadTransformations) (Core.moduleFromInfoTable tab)
   tab0 <- getRight $ mapLeft JuvixError r
-  let tab' = if project opts ^. coreReadNoDisambiguate then tab0 else Core.disambiguateNames tab0
+  let tab' = Core.computeCombinedInfoTable $ if project opts ^. coreReadNoDisambiguate then tab0 else Core.disambiguateNames tab0
   embed (Scoper.scopeTrace tab')
   unless (project opts ^. coreReadNoPrint) $ do
     renderStdOut (Pretty.ppOut opts tab')

app/Commands/Dev/Core/Repl.hs

@@ -3,6 +3,7 @@ module Commands.Dev.Core.Repl where
 import Commands.Base
 import Commands.Dev.Core.Repl.Options
 import Juvix.Compiler.Core.Data.InfoTable qualified as Core
+import Juvix.Compiler.Core.Data.Module qualified as Core
 import Juvix.Compiler.Core.Evaluator qualified as Core
 import Juvix.Compiler.Core.Extra.Base qualified as Core
 import Juvix.Compiler.Core.Info qualified as Info
@@ -18,10 +19,10 @@ import Juvix.Extra.Paths
 runCommand :: forall r. (Members '[Embed IO, App] r) => CoreReplOptions -> Sem r ()
 runCommand opts = do
   showReplWelcome
-  runRepl opts Core.emptyInfoTable
+  runRepl opts mempty
 
 parseText :: Core.InfoTable -> Text -> Either Core.MegaparsecError (Core.InfoTable, Maybe Core.Node)
-parseText = Core.runParser replPath
+parseText = Core.runParser replPath defaultModuleId
 
 runRepl :: forall r. (Members '[Embed IO, App] r) => CoreReplOptions -> Core.InfoTable -> Sem r ()
 runRepl opts tab = do
@@ -76,15 +77,15 @@ runRepl opts tab = do
       ':' : 'l' : ' ' : f -> do
         s' <- readFile f
         sf <- someBaseToAbs' (someFile f)
-        case Core.runParser sf Core.emptyInfoTable s' of
+        case Core.runParser sf defaultModuleId mempty s' of
           Left err -> do
             printJuvixError (JuvixError err)
             runRepl opts tab
           Right (tab', mnode) -> case mnode of
             Nothing -> runRepl opts tab'
             Just node -> replEval False tab' node
       ":r" ->
-        runRepl opts Core.emptyInfoTable
+        runRepl opts mempty
       _ ->
         case parseText tab s of
           Left err -> do
@@ -105,26 +106,28 @@ runRepl opts tab = do
         Right node'
           | Info.member Info.kNoDisplayInfo (Core.getInfo node') -> runRepl opts tab'
           | otherwise -> do
-              renderStdOut (Core.ppOut opts (Core.disambiguateNodeNames tab' node'))
+              renderStdOut (Core.ppOut opts (Core.disambiguateNodeNames (Core.moduleFromInfoTable tab') node'))
               embed (putStrLn "")
               runRepl opts tab'
       where
         defaultLoc = singletonInterval (mkInitialLoc replPath)
 
     replNormalize :: Core.InfoTable -> Core.Node -> Sem r ()
     replNormalize tab' node =
-      let node' = normalize tab' node
+      let md' = Core.moduleFromInfoTable tab'
+          node' = normalize md' node
        in if
               | Info.member Info.kNoDisplayInfo (Core.getInfo node') ->
                   runRepl opts tab'
               | otherwise -> do
-                  renderStdOut (Core.ppOut opts (Core.disambiguateNodeNames tab' node'))
+                  renderStdOut (Core.ppOut opts (Core.disambiguateNodeNames md' node'))
                   embed (putStrLn "")
                   runRepl opts tab'
 
     replType :: Core.InfoTable -> Core.Node -> Sem r ()
     replType tab' node = do
-      let ty = Core.disambiguateNodeNames tab' (Core.computeNodeType tab' node)
+      let md' = Core.moduleFromInfoTable tab'
+          ty = Core.disambiguateNodeNames md' (Core.computeNodeType md' node)
       renderStdOut (Core.ppOut opts ty)
       embed (putStrLn "")
       runRepl opts tab'