Add the juvix dev tree compile command (#2590)

* Adds the `juvix dev tree compile` CLI command.
* Depends on #2589 
* Depends on #2587 
* Depends on #2583

app/Commands/Dev/Tree.hs

@@ -1,6 +1,7 @@
 module Commands.Dev.Tree where
 
 import Commands.Base
+import Commands.Dev.Tree.Compile as Compile
 import Commands.Dev.Tree.Eval as Eval
 import Commands.Dev.Tree.FromAsm as FromAsm
 import Commands.Dev.Tree.Options
@@ -9,5 +10,6 @@ import Commands.Dev.Tree.Read as Read
 runCommand :: forall r. (Members '[Embed IO, App, TaggedLock] r) => TreeCommand -> Sem r ()
 runCommand = \case
   Eval opts -> Eval.runCommand opts
+  Compile opts -> Compile.runCommand opts
   Read opts -> Read.runCommand opts
   FromAsm opts -> FromAsm.runCommand opts

app/Commands/Dev/Tree/Compile.hs

@@ -0,0 +1,25 @@
+module Commands.Dev.Tree.Compile where
+
+import Commands.Base
+import Commands.Dev.Tree.Compile.Base
+import Commands.Dev.Tree.Compile.Options
+import Juvix.Compiler.Tree.Translation.FromSource qualified as Tree
+
+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 (Tree.runParser (toFilePath file) s))
+  let arg = PipelineArg opts file tab
+  case opts ^. compileTarget of
+    TargetWasm32Wasi -> runCPipeline arg
+    TargetNative64 -> runCPipeline arg
+    TargetGeb -> return ()
+    TargetVampIR -> return ()
+    TargetCore -> return ()
+    TargetAsm -> runAsmPipeline arg
+    TargetTree -> return ()
+    TargetNockma -> runNockmaPipeline arg
+  where
+    getFile :: Sem r (Path Abs File)
+    getFile = getMainFile (opts ^. compileInputFile)

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

@@ -0,0 +1,98 @@
+module Commands.Dev.Tree.Compile.Base where
+
+import Commands.Base
+import Commands.Dev.Tree.Compile.Options
+import Commands.Extra.Compile qualified as Compile
+import Juvix.Compiler.Asm.Pretty qualified as Asm
+import Juvix.Compiler.Backend qualified as Backend
+import Juvix.Compiler.Backend.C qualified as C
+import Juvix.Compiler.Nockma.Pretty qualified as Nockma
+import Juvix.Compiler.Tree.Data.InfoTable qualified as Tree
+
+data PipelineArg = PipelineArg
+  { _pipelineArgOptions :: CompileOptions,
+    _pipelineArgFile :: Path Abs File,
+    _pipelineArgTable :: Tree.InfoTable
+  }
+
+getEntry :: (Members '[Embed IO, App, TaggedLock] r) => PipelineArg -> Sem r EntryPoint
+getEntry PipelineArg {..} = do
+  ep <- getEntryPoint (AppPath (preFileFromAbs _pipelineArgFile) True)
+  return $
+    ep
+      { _entryPointTarget = getTarget (_pipelineArgOptions ^. compileTarget),
+        _entryPointDebug = _pipelineArgOptions ^. compileDebug,
+        _entryPointUnsafe = _pipelineArgOptions ^. compileUnsafe,
+        _entryPointOptimizationLevel = fromMaybe defaultOptLevel (_pipelineArgOptions ^. compileOptimizationLevel),
+        _entryPointInliningDepth = _pipelineArgOptions ^. compileInliningDepth
+      }
+  where
+    getTarget :: CompileTarget -> Backend.Target
+    getTarget = \case
+      TargetWasm32Wasi -> Backend.TargetCWasm32Wasi
+      TargetNative64 -> Backend.TargetCNative64
+      TargetGeb -> Backend.TargetGeb
+      TargetVampIR -> Backend.TargetVampIR
+      TargetCore -> Backend.TargetCore
+      TargetAsm -> Backend.TargetAsm
+      TargetTree -> Backend.TargetTree
+      TargetNockma -> Backend.TargetNockma
+
+    defaultOptLevel :: Int
+    defaultOptLevel
+      | _pipelineArgOptions ^. compileDebug = 0
+      | otherwise = defaultOptimizationLevel
+
+runCPipeline ::
+  forall r.
+  (Members '[Embed IO, App, TaggedLock] r) =>
+  PipelineArg ->
+  Sem r ()
+runCPipeline pa@PipelineArg {..} = do
+  entryPoint <- getEntry pa
+  C.MiniCResult {..} <-
+    getRight
+      . run
+      . runReader entryPoint
+      . runError @JuvixError
+      $ treeToMiniC _pipelineArgTable
+  cFile <- inputCFile _pipelineArgFile
+  embed @IO (writeFile (toFilePath cFile) _resultCCode)
+  outfile <- Compile.outputFile _pipelineArgOptions _pipelineArgFile
+  Compile.runCommand
+    _pipelineArgOptions
+      { _compileInputFile = Just (AppPath (preFileFromAbs cFile) False),
+        _compileOutputFile = Just (AppPath (preFileFromAbs outfile) False)
+      }
+  where
+    inputCFile :: Path Abs File -> Sem r (Path Abs File)
+    inputCFile inputFileCompile = do
+      buildDir <- askBuildDir
+      ensureDir buildDir
+      return (buildDir <//> replaceExtension' ".c" (filename inputFileCompile))
+
+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
+      . treeToAsm
+      $ _pipelineArgTable
+  tab' <- getRight r
+  let code = Asm.ppPrint tab' tab'
+  embed @IO (writeFile (toFilePath asmFile) code)
+
+runNockmaPipeline :: (Members '[Embed IO, App, TaggedLock] r) => PipelineArg -> Sem r ()
+runNockmaPipeline pa@PipelineArg {..} = do
+  entryPoint <- getEntry pa
+  nockmaFile <- Compile.outputFile _pipelineArgOptions _pipelineArgFile
+  r <-
+    runReader entryPoint
+      . runError @JuvixError
+      . treeToNockma
+      $ _pipelineArgTable
+  tab' <- getRight r
+  let code = Nockma.ppSerialize tab'
+  embed @IO (writeFile (toFilePath nockmaFile) code)

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

@@ -0,0 +1,22 @@
+module Commands.Dev.Tree.Compile.Options
+  ( module Commands.Dev.Tree.Compile.Options,
+    module Commands.Extra.Compile.Options,
+  )
+where
+
+import Commands.Extra.Compile.Options
+import CommonOptions
+
+treeSupportedTargets :: NonEmpty CompileTarget
+treeSupportedTargets =
+  nonEmpty'
+    [ TargetWasm32Wasi,
+      TargetNative64,
+      TargetAsm
+    ]
+
+parseTreeCompileOptions :: Parser CompileOptions
+parseTreeCompileOptions =
+  parseCompileOptions
+    treeSupportedTargets
+    (parseInputFile FileExtJuvixTree)

app/Commands/Dev/Tree/Options.hs

@@ -1,12 +1,14 @@
 module Commands.Dev.Tree.Options where
 
+import Commands.Dev.Tree.Compile.Options
 import Commands.Dev.Tree.Eval.Options
 import Commands.Dev.Tree.FromAsm.Options
 import Commands.Dev.Tree.Read.Options
 import CommonOptions
 
 data TreeCommand
   = Eval TreeEvalOptions
+  | Compile CompileOptions
   | Read TreeReadOptions
   | FromAsm TreeFromAsmOptions
   deriving stock (Data)
@@ -16,13 +18,17 @@ parseTreeCommand =
   hsubparser $
     mconcat
       [ commandEval,
+        commandCompile,
         commandRead,
         commandFromAsm
       ]
   where
     commandEval :: Mod CommandFields TreeCommand
     commandEval = command "eval" evalInfo
 
+    commandCompile :: Mod CommandFields TreeCommand
+    commandCompile = command "compile" compileInfo
+
     commandRead :: Mod CommandFields TreeCommand
     commandRead = command "read" readInfo
 
@@ -35,6 +41,12 @@ parseTreeCommand =
         (Eval <$> parseTreeEvalOptions)
         (progDesc "Evaluate a JuvixTree file")
 
+    compileInfo :: ParserInfo TreeCommand
+    compileInfo =
+      info
+        (Compile <$> parseTreeCompileOptions)
+        (progDesc "Compile a JuvixTree file")
+
     readInfo :: ParserInfo TreeCommand
     readInfo =
       info

src/Juvix/Compiler/Pipeline.hs

@@ -179,6 +179,12 @@ coreToVampIR' = Core.toStored' >=> storedCoreToVampIR'
 treeToAsm :: Tree.InfoTable -> Sem r Asm.InfoTable
 treeToAsm = return . Asm.fromTree
 
+treeToNockma :: (Members '[Error JuvixError, Reader EntryPoint] r) => Tree.InfoTable -> Sem r (Nockma.Cell Natural)
+treeToNockma = treeToAsm >=> asmToNockma
+
+treeToMiniC :: (Members '[Error JuvixError, Reader EntryPoint] r) => Tree.InfoTable -> Sem r C.MiniCResult
+treeToMiniC = treeToAsm >=> asmToMiniC
+
 asmToNockma :: (Members '[Error JuvixError, Reader EntryPoint] r) => Asm.InfoTable -> Sem r (Nockma.Cell Natural)
 asmToNockma = Asm.toNockma >=> mapReader Nockma.fromEntryPoint . Nockma.fromAsmTable