Modular compilation in JuvixTree

app/App.hs

@@ -4,12 +4,17 @@ import CommonOptions
 import Data.ByteString qualified as ByteString
 import GlobalOptions
 import Juvix.Compiler.Backend.Markdown.Error
+import Juvix.Compiler.Core.Data.Module qualified as Core
+import Juvix.Compiler.Core.Data.TransformationId qualified as Core
 import Juvix.Compiler.Internal.Translation (InternalTypedResult)
 import Juvix.Compiler.Internal.Translation.FromInternal.Analysis.Termination.Checker
 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.Data.Error qualified as Error
+import Juvix.Data.SHA256 qualified as SHA256
 import Juvix.Extra.Paths.Base hiding (rootBuildDir)
 import Juvix.Parser.Error
 import System.Console.ANSI qualified as Ansi
@@ -170,7 +175,20 @@ getEntryPoint' RunAppIOArgs {..} inputFile = do
         | opts ^. globalStdin -> Just <$> liftIO getContents
         | otherwise -> return Nothing
   mainFile <- getMainAppFileMaybe inputFile
-  set entryPointStdin estdin <$> entryPointFromGlobalOptionsPre root ((^. pathPath) <$> mainFile) opts
+  mainFile' <- maybe (return Nothing) (fmap Just . fromAppFile) mainFile
+  sha256 <- maybe (return Nothing) (fmap Just . runFilesIO . SHA256.digestFile) mainFile'
+  set entryPointSHA256 sha256
+    . 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) =>
@@ -179,8 +197,7 @@ runPipelineEither ::
   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
@@ -330,6 +347,18 @@ 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) ->
+  Maybe Core.TransformationId ->
+  (Core.ModuleTable -> Sem (ModularEff r) a) ->
+  Sem r (ModuleId, a)
+runPipelineModular opts input_ checkId f = runPipelineOptions $ do
+  entry <- getEntryPoint'' opts input_
+  Pipeline.Modular.runIOEitherModular checkId entry (inject . f) >>= fromRightJuvixError
+
 renderStdOutLn :: forall a r. (Member App r, HasAnsiBackend a, HasTextBackend a) => a -> Sem r ()
 renderStdOutLn txt = renderStdOut txt >> newline
 

app/AsmInterpreter.hs

@@ -2,36 +2,36 @@ module AsmInterpreter where
 
 import App
 import CommonOptions
-import Juvix.Compiler.Asm.Data.InfoTable qualified as Asm
+import Juvix.Compiler.Asm.Data.Module qualified as Asm
 import Juvix.Compiler.Asm.Extra qualified as Asm
 import Juvix.Compiler.Asm.Interpreter qualified as Asm
 import Juvix.Compiler.Asm.Pretty qualified as Asm
 import Juvix.Compiler.Asm.Transformation.Validate qualified as Asm
 
-runAsm :: forall r. (Members '[EmbedIO, App] r) => Bool -> Asm.InfoTable -> Sem r ()
-runAsm bValidate tab =
-  let v = if bValidate then Asm.validate' tab else Nothing
+runAsm :: forall r. (Members '[EmbedIO, App] r) => Bool -> Asm.Module -> Sem r ()
+runAsm bValidate md =
+  let v = if bValidate then Asm.validate' md else Nothing
    in case v of
         Just err ->
           exitJuvixError (JuvixError err)
         Nothing ->
-          case tab ^. Asm.infoMainFunction of
+          case md ^. Asm.moduleInfoTable . Asm.infoMainFunction of
             Just sym -> do
-              r <- doRun tab (Asm.lookupFunInfo tab sym)
+              r <- doRun md (Asm.lookupFunInfo md sym)
               case r of
                 Left err ->
                   exitJuvixError (JuvixError err)
                 Right Asm.ValVoid ->
                   return ()
                 Right val -> do
-                  renderStdOut (Asm.ppOut (Asm.defaultOptions tab) val)
+                  renderStdOut (Asm.ppOut (Asm.defaultOptions md) val)
                   putStrLn ""
             Nothing ->
               exitMsg (ExitFailure 1) "no 'main' function"
   where
     doRun ::
-      Asm.InfoTable ->
+      Asm.Module ->
       Asm.FunctionInfo ->
       Sem r (Either Asm.AsmError Asm.Val)
-    doRun tab' funInfo =
-      liftIO $ Asm.catchRunErrorIO (Asm.runCodeIO tab' funInfo)
+    doRun md' funInfo =
+      liftIO $ Asm.catchRunErrorIO (Asm.runCodeIO md' funInfo)

app/Commands/Dev/Asm/Compile.hs

@@ -9,13 +9,14 @@ import Juvix.Compiler.Backend qualified as Backend
 import Juvix.Compiler.Backend.C qualified as C
 import Juvix.Compiler.Casm.Data.Result qualified as Casm
 import Juvix.Compiler.Casm.Pretty qualified as Casm
+import Juvix.Compiler.Reg.Data.Module qualified as Reg
 import Juvix.Compiler.Reg.Pretty qualified as Reg
 
 runCommand :: forall r. (Members '[EmbedIO, App, TaggedLock] r) => AsmCompileOptions -> Sem r ()
 runCommand opts = do
   file <- getMainFile (Just (opts ^. compileInputFile))
   s <- readFile file
-  tab <- fromRightGenericError (Asm.runParser file s)
+  md <- fromRightGenericError (Asm.runParser file s)
   ep <- getEntryPoint (Just (opts ^. compileInputFile))
   tgt <- getTarget (opts ^. compileTarget)
   let entryPoint :: EntryPoint
@@ -31,17 +32,17 @@ runCommand opts = do
         runReader entryPoint
           . runError @JuvixError
           . asmToReg
-          $ tab
-      tab' <- getRight r
-      let code = Reg.ppPrint tab' tab'
+          $ md
+      md' <- getRight r
+      let code = Reg.ppPrint md' (Reg.computeCombinedInfoTable md')
       writeFileEnsureLn regFile code
     AppTargetCasm -> do
       casmFile <- Compile.outputFile opts
       r <-
         runReader entryPoint
           . runError @JuvixError
           . asmToCasm
-          $ tab
+          $ md
       Casm.Result {..} <- getRight r
       writeFileEnsureLn casmFile (toPlainText $ Casm.ppProgram _resultCode)
     AppTargetCairo -> do
@@ -50,7 +51,7 @@ runCommand opts = do
         runReader entryPoint
           . runError @JuvixError
           . asmToCairo
-          $ tab
+          $ md
       res <- getRight r
       liftIO $ JSON.encodeFile (toFilePath cairoFile) res
     _ -> do
@@ -59,7 +60,7 @@ runCommand opts = do
           . run
           . runReader entryPoint
           . runError
-          $ asmToMiniC tab
+          $ asmToMiniC md
       buildDir <- askBuildDir
       ensureDir buildDir
       cFile <- inputCFile file

app/Commands/Dev/Asm/Run.hs

@@ -11,7 +11,7 @@ runCommand opts = do
   s <- readFile afile
   case Asm.runParser afile s of
     Left err -> exitJuvixError (JuvixError err)
-    Right tab -> runAsm (not (opts ^. asmRunNoValidate)) tab
+    Right md -> runAsm (not (opts ^. asmRunNoValidate)) md
   where
     file :: AppPath File
     file = opts ^. asmRunInputFile

app/Commands/Dev/Asm/Validate.hs

@@ -2,6 +2,7 @@ module Commands.Dev.Asm.Validate where
 
 import Commands.Base
 import Commands.Dev.Asm.Validate.Options
+import Juvix.Compiler.Asm.Data.Module qualified as Asm
 import Juvix.Compiler.Asm.Pretty qualified as Asm
 import Juvix.Compiler.Asm.Transformation.Validate qualified as Asm
 import Juvix.Compiler.Asm.Translation.FromSource qualified as Asm
@@ -12,16 +13,16 @@ runCommand opts = do
   s <- readFile afile
   case Asm.runParser afile s of
     Left err -> exitJuvixError (JuvixError err)
-    Right tab -> do
-      case Asm.validate' tab of
+    Right md -> do
+      case Asm.validate' md of
         Just err ->
           exitJuvixError (JuvixError err)
         Nothing ->
           if
               | opts ^. asmValidateNoPrint ->
                   exitMsg ExitSuccess "validation succeeded"
               | otherwise -> do
-                  renderStdOut (Asm.ppOutDefault tab tab)
+                  renderStdOut (Asm.ppOutDefault md (Asm.computeCombinedInfoTable md))
                   exitMsg ExitSuccess ""
   where
     file :: AppPath File

app/Commands/Dev/Core/Asm.hs

@@ -17,11 +17,11 @@ runCommand opts = do
   s' <- readFile inputFile
   tab <- getRight (Core.runParserMain inputFile defaultModuleId mempty s')
   r <- runReader ep . runError @JuvixError $ coreToAsm (Core.moduleFromInfoTable tab)
-  tab' <- getRight r
+  md' <- getRight r
   if
       | project opts ^. coreAsmPrint ->
-          renderStdOut (Asm.ppOutDefault tab' tab')
-      | otherwise -> runAsm True tab'
+          renderStdOut (Asm.ppOutDefault md' (Asm.computeCombinedInfoTable md'))
+      | otherwise -> runAsm True md'
   where
     sinputFile :: AppPath File
     sinputFile = project opts ^. coreAsmInputFile

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

@@ -2,9 +2,9 @@ module Commands.Dev.Core.Compile.Base where
 
 import Commands.Base
 import Commands.Dev.Core.Compile.Options
-import Commands.Dev.Tree.CompileOld.Base (outputAnomaResult)
 import Commands.Extra.Compile qualified as Compile
 import Data.Aeson qualified as JSON
+import Juvix.Compiler.Asm.Data.Module qualified as Asm
 import Juvix.Compiler.Asm.Pretty qualified as Asm
 import Juvix.Compiler.Backend qualified as Backend
 import Juvix.Compiler.Backend.C qualified as C
@@ -13,14 +13,25 @@ import Juvix.Compiler.Casm.Data.Result qualified as Casm
 import Juvix.Compiler.Casm.Pretty qualified as Casm
 import Juvix.Compiler.Core.Data.Module qualified as Core
 import Juvix.Compiler.Core.Data.TransformationId qualified as Core
+import Juvix.Compiler.Nockma.Pretty qualified as Nockma
+import Juvix.Compiler.Nockma.Translation.FromTree qualified as Nockma
+import Juvix.Compiler.Reg.Data.Module qualified as Reg
 import Juvix.Compiler.Reg.Pretty qualified as Reg
+import Juvix.Compiler.Tree.Data.Module qualified as Tree
 import Juvix.Compiler.Tree.Pretty qualified as Tree
 
 data PipelineArg = PipelineArg
   { _pipelineArgOptions :: CompileOptions,
     _pipelineArgModule :: Core.Module
   }
 
+outputAnomaResult :: (Members '[EmbedIO, App] r) => Path Abs File -> Nockma.AnomaResult -> Sem r ()
+outputAnomaResult nockmaFile Nockma.AnomaResult {..} = do
+  let code = Nockma.ppSerialize _anomaClosure
+      prettyNockmaFile = replaceExtensions' [".pretty", ".nockma"] nockmaFile
+  writeFileEnsureLn nockmaFile code
+  writeFileEnsureLn prettyNockmaFile (Nockma.ppPrint _anomaClosure)
+
 getEntry :: (Members '[EmbedIO, App, TaggedLock] r) => PipelineArg -> Sem r EntryPoint
 getEntry PipelineArg {..} = do
   ep <- getEntryPoint (Just (_pipelineArgOptions ^. compileInputFile))
@@ -89,8 +100,8 @@ runAsmPipeline pa@PipelineArg {..} = do
       . runError @JuvixError
       . coreToAsm
       $ _pipelineArgModule
-  tab' <- getRight r
-  let code = Asm.ppPrint tab' tab'
+  md' <- getRight r
+  let code = Asm.ppPrint md' (Asm.computeCombinedInfoTable md')
   writeFileEnsureLn asmFile code
 
 runRegPipeline :: (Members '[EmbedIO, App, TaggedLock] r) => PipelineArg -> Sem r ()
@@ -102,8 +113,8 @@ runRegPipeline pa@PipelineArg {..} = do
       . runError @JuvixError
       . coreToReg
       $ _pipelineArgModule
-  tab' <- getRight r
-  let code = Reg.ppPrint tab' tab'
+  md' <- getRight r
+  let code = Reg.ppPrint md' (Reg.computeCombinedInfoTable md')
   writeFileEnsureLn regFile code
 
 runTreePipeline :: (Members '[EmbedIO, App, TaggedLock] r) => PipelineArg -> Sem r ()
@@ -115,8 +126,8 @@ runTreePipeline pa@PipelineArg {..} = do
       . runError @JuvixError
       . coreToTree Core.IdentityTrans
       $ _pipelineArgModule
-  tab' <- getRight r
-  let code = Tree.ppPrint tab' tab'
+  md' <- getRight r
+  let code = Tree.ppPrint md' (Tree.computeCombinedInfoTable md')
   writeFileEnsureLn treeFile code
 
 runAnomaPipeline :: (Members '[EmbedIO, App, TaggedLock] r) => PipelineArg -> Sem r ()

app/Commands/Dev/Core/Strip.hs

@@ -21,7 +21,7 @@ runCommand opts = do
           $ Core.toStripped Core.IdentityTrans (Core.moduleFromInfoTable tab)
   tab' <-
     getRight $
-      mapRight (Stripped.fromCore (project gopts ^. Core.optFieldSize) . Core.computeCombinedInfoTable) r
+      mapRight (Stripped.fromCore' . Core.computeCombinedInfoTable) r
   unless (project opts ^. coreStripNoPrint) $ do
     renderStdOut (Core.ppOut opts tab')
   where

app/Commands/Dev/DevCompile/Asm.hs

@@ -3,14 +3,14 @@ module Commands.Dev.DevCompile.Asm where
 import Commands.Base
 import Commands.Dev.DevCompile.Asm.Options
 import Commands.Extra.NewCompile
-import Juvix.Compiler.Asm.Data.InfoTable
+import Juvix.Compiler.Asm.Data.Module
 import Juvix.Compiler.Asm.Pretty
 
 runCommand :: (Members AppEffects r) => AsmOptions 'InputMain -> Sem r ()
 runCommand opts = do
   let inputFile = opts ^. asmCompileCommonOptions . compileInputFile
       moutputFile = opts ^. asmCompileCommonOptions . compileOutputFile
   outFile :: Path Abs File <- getOutputFile FileExtJuvixAsm inputFile moutputFile
-  res :: InfoTable <- runPipeline opts inputFile upToAsm
-  let txt = ppPrint res res
+  res :: Module <- runPipeline opts inputFile upToAsm
+  let txt = ppPrint res (computeCombinedInfoTable res)
   writeFileEnsureLn outFile txt

app/Commands/Dev/DevCompile/Asm/Options.hs

@@ -23,4 +23,7 @@ parseAsm = do
   pure AsmOptions {..}
 
 instance EntryPointOptions (AsmOptions k) where
-  applyOptions = applyOptions . (^. asmCompileCommonOptions)
+  applyOptions opts =
+    set entryPointPipeline (Just PipelineExec)
+      . set entryPointTarget (Just TargetAsm)
+      . applyOptions (opts ^. asmCompileCommonOptions)

app/Commands/Dev/DevCompile/Core/Options.hs

@@ -23,4 +23,7 @@ parseCore = do
   pure CoreOptions {..}
 
 instance EntryPointOptions (CoreOptions k) where
-  applyOptions = applyOptions . (^. coreCompileCommonOptions)
+  applyOptions opts =
+    set entryPointPipeline (Just PipelineExec)
+      . set entryPointTarget (Just TargetCore)
+      . applyOptions (opts ^. coreCompileCommonOptions)

app/Commands/Dev/DevCompile/Reg.hs

@@ -3,7 +3,7 @@ module Commands.Dev.DevCompile.Reg where
 import Commands.Base
 import Commands.Dev.DevCompile.Reg.Options
 import Commands.Extra.NewCompile
-import Juvix.Compiler.Reg.Data.InfoTable
+import Juvix.Compiler.Reg.Data.Module
 import Juvix.Compiler.Reg.Pretty
 
 runCommand ::
@@ -14,6 +14,6 @@ runCommand opts = do
   let inputFile = opts ^. regCompileCommonOptions . compileInputFile
       moutputFile = opts ^. regCompileCommonOptions . compileOutputFile
   outFile :: Path Abs File <- getOutputFile FileExtJuvixReg inputFile moutputFile
-  res :: InfoTable <- runPipeline opts inputFile upToReg
-  let txt = ppPrint res res
+  res :: Module <- runPipeline opts inputFile upToReg
+  let txt = ppPrint res (computeCombinedInfoTable res)
   writeFileEnsureLn outFile txt

app/Commands/Dev/DevCompile/Tree.hs

@@ -3,8 +3,10 @@ module Commands.Dev.DevCompile.Tree where
 import Commands.Base
 import Commands.Dev.DevCompile.Tree.Options
 import Commands.Extra.NewCompile
-import Juvix.Compiler.Tree.Data.InfoTable
+import Juvix.Compiler.Pipeline.Modular (modularCoreToTree)
+import Juvix.Compiler.Tree.Data.Module
 import Juvix.Compiler.Tree.Pretty
+import Juvix.Compiler.Tree.Transformation.FilterUnreachable
 
 runCommand ::
   (Members AppEffects r) =>
@@ -14,6 +16,7 @@ runCommand opts = do
   let inputFile = opts ^. treeCompileCommonOptions . compileInputFile
       moutputFile = opts ^. treeCompileCommonOptions . compileOutputFile
   outFile :: Path Abs File <- getOutputFile FileExtJuvixTree inputFile moutputFile
-  res :: InfoTable <- runPipeline opts inputFile upToTree
-  let txt = ppPrint res res
+  (mid, mtab) <- runPipelineModular opts inputFile Nothing modularCoreToTree
+  let md = filterUnreachable (combineInfoTables (lookupModuleTable mtab mid))
+      txt = ppPrint md (md ^. moduleInfoTable)
   writeFileEnsureLn outFile txt

app/Commands/Dev/DevCompile/Tree/Options.hs

@@ -23,4 +23,7 @@ parseTree = do
   pure TreeOptions {..}
 
 instance EntryPointOptions (TreeOptions k) where
-  applyOptions = applyOptions . (^. treeCompileCommonOptions)
+  applyOptions opts =
+    set entryPointPipeline (Just PipelineExec)
+      . set entryPointTarget (Just TargetTree)
+      . applyOptions (opts ^. treeCompileCommonOptions)