JuvixReg to CASM translation (#2671)

* Closes #2562 

Checklist
---------

- [x] Translation from JuvixReg to CASM
- [x] CASM runtime
- [x] Juvix to CASM pipeline: combine the right transformations and
check prerequisites
- [x] CLI commands: add target `casm` to the `compile` commands
- [x] Tests:
   - [x] Test the translation from JuvixReg to CASM
   - [x] Test the entire pipeline from Juvix to CASM

app/Commands/Compile.hs

@@ -29,6 +29,7 @@ runCommand opts@CompileOptions {..} = do
     TargetReg -> Compile.runRegPipeline arg
     TargetNockma -> Compile.runNockmaPipeline arg
     TargetAnoma -> Compile.runAnomaPipeline arg
+    TargetCasm -> Compile.runCasmPipeline arg
 
 writeCoreFile :: (Members '[EmbedIO, App, TaggedLock] r) => Compile.PipelineArg -> Sem r ()
 writeCoreFile pa@Compile.PipelineArg {..} = do

app/Commands/Dev/Asm/Compile.hs

@@ -6,7 +6,10 @@ import Commands.Extra.Compile qualified as Compile
 import Juvix.Compiler.Asm.Translation.FromSource qualified as Asm
 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.Pretty qualified as Reg
+import Juvix.Prelude.Pretty
 
 runCommand :: forall r. (Members '[EmbedIO, App, TaggedLock] r) => AsmCompileOptions -> Sem r ()
 runCommand opts = do
@@ -34,6 +37,15 @@ runCommand opts = do
           tab' <- getRight r
           let code = Reg.ppPrint tab' tab'
           writeFileEnsureLn regFile code
+        TargetCasm -> do
+          casmFile <- Compile.outputFile opts file
+          r <-
+            runReader entryPoint
+              . runError @JuvixError
+              . asmToCasm
+              $ tab
+          Casm.Result {..} <- getRight r
+          writeFileEnsureLn casmFile (toPlainText $ Casm.ppProgram _resultCode)
         _ ->
           case run $ runReader entryPoint $ runError $ asmToMiniC tab of
             Left err -> exitJuvixError err
@@ -57,6 +69,7 @@ runCommand opts = do
       TargetWasm32Wasi -> return Backend.TargetCWasm32Wasi
       TargetNative64 -> return Backend.TargetCNative64
       TargetReg -> return Backend.TargetReg
+      TargetCasm -> return Backend.TargetCairo
       TargetNockma -> err "Nockma"
       TargetAnoma -> err "Anoma"
       TargetTree -> err "JuvixTree"

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

@@ -15,7 +15,8 @@ asmSupportedTargets =
   NonEmpty.fromList
     [ TargetWasm32Wasi,
       TargetNative64,
-      TargetReg
+      TargetReg,
+      TargetCasm
     ]
 
 parseAsmCompileOptions :: Parser AsmCompileOptions

app/Commands/Dev/Core/Compile.hs

@@ -23,6 +23,7 @@ runCommand opts = do
     TargetTree -> runTreePipeline arg
     TargetNockma -> runNockmaPipeline arg
     TargetAnoma -> runAnomaPipeline arg
+    TargetCasm -> runCasmPipeline arg
   where
     getFile :: Sem r (Path Abs File)
     getFile = getMainFile (opts ^. compileInputFile)

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

@@ -8,11 +8,14 @@ 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.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.Reg.Pretty qualified as Reg
 import Juvix.Compiler.Tree.Pretty qualified as Tree
+import Juvix.Prelude.Pretty
 import System.FilePath (takeBaseName)
 
 data PipelineArg = PipelineArg
@@ -45,6 +48,7 @@ getEntry PipelineArg {..} = do
       TargetTree -> Backend.TargetTree
       TargetNockma -> Backend.TargetNockma
       TargetAnoma -> Backend.TargetAnoma
+      TargetCasm -> Backend.TargetCairo
 
     defaultOptLevel :: Int
     defaultOptLevel
@@ -168,3 +172,15 @@ runAnomaPipeline pa@PipelineArg {..} = do
   tab' <- getRight r
   let code = Nockma.ppSerialize tab'
   writeFileEnsureLn nockmaFile code
+
+runCasmPipeline :: (Members '[Embed IO, App, TaggedLock] r) => PipelineArg -> Sem r ()
+runCasmPipeline pa@PipelineArg {..} = do
+  entryPoint <- getEntry pa
+  casmFile <- Compile.outputFile _pipelineArgOptions _pipelineArgFile
+  r <-
+    runReader entryPoint
+      . runError @JuvixError
+      . coreToCasm
+      $ _pipelineArgModule
+  Casm.Result {..} <- getRight r
+  writeFileEnsureLn casmFile (toPlainText $ Casm.ppProgram _resultCode)

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

@@ -19,7 +19,8 @@ coreSupportedTargets =
       TargetVampIR,
       TargetTree,
       TargetAsm,
-      TargetReg
+      TargetReg,
+      TargetCasm
     ]
 
 parseCoreCompileOptions :: Parser CoreCompileOptions

app/Commands/Dev/Reg.hs

@@ -1,11 +1,13 @@
 module Commands.Dev.Reg where
 
 import Commands.Base
+import Commands.Dev.Reg.Compile as Compile
 import Commands.Dev.Reg.Options
 import Commands.Dev.Reg.Read as Read
 import Commands.Dev.Reg.Run as Run
 
 runCommand :: forall r. (Members '[EmbedIO, App, TaggedLock] r) => RegCommand -> Sem r ()
 runCommand = \case
+  Compile opts -> Compile.runCommand opts
   Run opts -> Run.runCommand opts
   Read opts -> Read.runCommand opts

app/Commands/Dev/Reg/Compile.hs

@@ -0,0 +1,79 @@
+module Commands.Dev.Reg.Compile where
+
+import Commands.Base
+import Commands.Dev.Reg.Compile.Options
+import Commands.Extra.Compile qualified as Compile
+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.Translation.FromSource qualified as Reg
+import Juvix.Prelude.Pretty
+
+runCommand :: forall r. (Members '[EmbedIO, App, TaggedLock] r) => CompileOptions -> Sem r ()
+runCommand opts = do
+  file <- getFile
+  s <- readFile file
+  case Reg.runParser file s of
+    Left err -> exitJuvixError (JuvixError err)
+    Right tab -> do
+      ep <- getEntryPoint (AppPath (preFileFromAbs file) True)
+      tgt <- getTarget (opts ^. compileTarget)
+      let entryPoint :: EntryPoint
+          entryPoint =
+            ep
+              { _entryPointTarget = tgt,
+                _entryPointDebug = opts ^. compileDebug
+              }
+      case opts ^. compileTarget of
+        TargetCasm -> do
+          casmFile <- Compile.outputFile opts file
+          r <-
+            runReader entryPoint
+              . runError @JuvixError
+              . regToCasm
+              $ tab
+          Casm.Result {..} <- getRight r
+          writeFileEnsureLn casmFile (toPlainText $ Casm.ppProgram _resultCode)
+        _ ->
+          case run $ runReader entryPoint $ runError $ regToMiniC tab of
+            Left err -> exitJuvixError err
+            Right C.MiniCResult {..} -> do
+              buildDir <- askBuildDir
+              ensureDir buildDir
+              cFile <- inputCFile file
+              writeFileEnsureLn cFile _resultCCode
+              outfile <- Compile.outputFile opts file
+              Compile.runCommand
+                opts
+                  { _compileInputFile = Just (AppPath (preFileFromAbs cFile) False),
+                    _compileOutputFile = Just (AppPath (preFileFromAbs outfile) False)
+                  }
+  where
+    getFile :: Sem r (Path Abs File)
+    getFile = getMainFile (opts ^. compileInputFile)
+
+    getTarget :: CompileTarget -> Sem r Backend.Target
+    getTarget = \case
+      TargetWasm32Wasi -> return Backend.TargetCWasm32Wasi
+      TargetNative64 -> return Backend.TargetCNative64
+      TargetCasm -> return Backend.TargetCairo
+      TargetReg -> err "JuvixReg"
+      TargetNockma -> err "Nockma"
+      TargetAnoma -> err "Anoma"
+      TargetTree -> err "JuvixTree"
+      TargetGeb -> err "GEB"
+      TargetVampIR -> err "VampIR"
+      TargetCore -> err "JuvixCore"
+      TargetAsm -> err "JuvixAsm"
+      where
+        err :: Text -> Sem r a
+        err tgt = exitMsg (ExitFailure 1) ("error: " <> tgt <> " target not supported for JuvixReg")
+
+inputCFile :: (Members '[App] r) => Path Abs File -> Sem r (Path Abs File)
+inputCFile inputFileCompile = do
+  buildDir <- askBuildDir
+  return (buildDir <//> outputMiniCFile)
+  where
+    outputMiniCFile :: Path Rel File
+    outputMiniCFile = replaceExtension' ".c" (filename inputFileCompile)

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

@@ -0,0 +1,23 @@
+module Commands.Dev.Reg.Compile.Options
+  ( module Commands.Dev.Reg.Compile.Options,
+    module Commands.Extra.Compile.Options,
+  )
+where
+
+import Commands.Extra.Compile.Options
+import CommonOptions
+import Data.List.NonEmpty qualified as NonEmpty
+
+regSupportedTargets :: NonEmpty CompileTarget
+regSupportedTargets =
+  NonEmpty.fromList
+    [ TargetWasm32Wasi,
+      TargetNative64,
+      TargetCasm
+    ]
+
+parseRegCompileOptions :: Parser CompileOptions
+parseRegCompileOptions =
+  parseCompileOptions
+    regSupportedTargets
+    (parseInputFile FileExtJuvixReg)

app/Commands/Dev/Reg/Options.hs

@@ -1,28 +1,40 @@
 module Commands.Dev.Reg.Options where
 
+import Commands.Dev.Reg.Compile.Options
 import Commands.Dev.Reg.Read.Options
 import Commands.Dev.Reg.Run.Options
 import CommonOptions
 
 data RegCommand
-  = Run RegRunOptions
+  = Compile CompileOptions
+  | Run RegRunOptions
   | Read RegReadOptions
   deriving stock (Data)
 
 parseRegCommand :: Parser RegCommand
 parseRegCommand =
   hsubparser $
     mconcat
-      [ commandRun,
+      [ commandCompile,
+        commandRun,
         commandRead
       ]
   where
+    commandCompile :: Mod CommandFields RegCommand
+    commandCompile = command "compile" compileInfo
+
     commandRun :: Mod CommandFields RegCommand
     commandRun = command "run" runInfo
 
     commandRead :: Mod CommandFields RegCommand
     commandRead = command "read" readInfo
 
+    compileInfo :: ParserInfo RegCommand
+    compileInfo =
+      info
+        (Compile <$> parseRegCompileOptions)
+        (progDesc "Compile a JuvixReg file")
+
     runInfo :: ParserInfo RegCommand
     runInfo =
       info

app/Commands/Dev/Tree/Compile.hs

@@ -22,6 +22,7 @@ runCommand opts = do
     TargetTree -> return ()
     TargetNockma -> runNockmaPipeline arg
     TargetAnoma -> runAnomaPipeline arg
+    TargetCasm -> runCasmPipeline arg
   where
     getFile :: Sem r (Path Abs File)
     getFile = getMainFile (opts ^. compileInputFile)

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

@@ -6,9 +6,12 @@ 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.Casm.Data.Result qualified as Casm
+import Juvix.Compiler.Casm.Pretty qualified as Casm
 import Juvix.Compiler.Nockma.Pretty qualified as Nockma
 import Juvix.Compiler.Reg.Pretty qualified as Reg
 import Juvix.Compiler.Tree.Data.InfoTable qualified as Tree
+import Juvix.Prelude.Pretty
 
 data PipelineArg = PipelineArg
   { _pipelineArgOptions :: CompileOptions,
@@ -40,6 +43,7 @@ getEntry PipelineArg {..} = do
       TargetTree -> Backend.TargetTree
       TargetNockma -> Backend.TargetNockma
       TargetAnoma -> Backend.TargetAnoma
+      TargetCasm -> Backend.TargetCairo
 
     defaultOptLevel :: Int
     defaultOptLevel
@@ -125,3 +129,15 @@ runAnomaPipeline pa@PipelineArg {..} = do
   tab' <- getRight r
   let code = Nockma.ppSerialize tab'
   writeFileEnsureLn nockmaFile code
+
+runCasmPipeline :: (Members '[Embed IO, App, TaggedLock] r) => PipelineArg -> Sem r ()
+runCasmPipeline pa@PipelineArg {..} = do
+  entryPoint <- getEntry pa
+  casmFile <- Compile.outputFile _pipelineArgOptions _pipelineArgFile
+  r <-
+    runReader entryPoint
+      . runError @JuvixError
+      . treeToCasm
+      $ _pipelineArgTable
+  Casm.Result {..} <- getRight r
+  writeFileEnsureLn casmFile (toPlainText $ Casm.ppProgram _resultCode)

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

@@ -14,7 +14,8 @@ treeSupportedTargets =
       TargetNative64,
       TargetAsm,
       TargetReg,
-      TargetNockma
+      TargetNockma,
+      TargetCasm
     ]
 
 parseTreeCompileOptions :: Parser CompileOptions

app/Commands/Extra/Compile.hs

@@ -37,6 +37,7 @@ runCompile inputFile o = do
     TargetTree -> return (Right ())
     TargetNockma -> return (Right ())
     TargetAnoma -> return (Right ())
+    TargetCasm -> return (Right ())
 
 prepareRuntime :: forall r. (Members '[App, EmbedIO] r) => Path Abs Dir -> CompileOptions -> Sem r ()
 prepareRuntime buildDir o = do
@@ -56,6 +57,7 @@ prepareRuntime buildDir o = do
     TargetTree -> return ()
     TargetNockma -> return ()
     TargetAnoma -> return ()
+    TargetCasm -> return ()
   where
     wasiReleaseRuntime :: BS.ByteString
     wasiReleaseRuntime = $(FE.makeRelativeToProject "runtime/_build.wasm32-wasi/libjuvix.a" >>= FE.embedFile)
@@ -121,6 +123,8 @@ outputFile opts inputFile =
           replaceExtension' nockmaFileExt baseOutputFile
         TargetAnoma ->
           replaceExtension' nockmaFileExt baseOutputFile
+        TargetCasm ->
+          replaceExtension' casmFileExt baseOutputFile
 
 clangNativeCompile ::
   forall r.

app/Commands/Extra/Compile/Options.hs

@@ -15,6 +15,7 @@ data CompileTarget
   | TargetTree
   | TargetNockma
   | TargetAnoma
+  | TargetCasm
   deriving stock (Eq, Data, Bounded, Enum)
 
 instance Show CompileTarget where
@@ -29,6 +30,7 @@ instance Show CompileTarget where
     TargetTree -> "tree"
     TargetNockma -> "nockma"
     TargetAnoma -> "anoma"
+    TargetCasm -> "casm"
 
 data CompileOptions = CompileOptions
   { _compileDebug :: Bool,

cntlines.sh

@@ -11,8 +11,9 @@ function count_ext () {
 RUNTIME_C=$(count runtime/src/juvix)
 RUNTIME_VAMPIR=$(count_ext '*.pir' runtime/src/vampir)
 RUNTIME_JVT=$(count_ext '*.jvt' runtime/src/tree)
+RUNTIME_CASM=$(count_ext '*.casm' runtime/src/casm)
 
-RUNTIME=$((RUNTIME_C+RUNTIME_VAMPIR+RUNTIME_JVT))
+RUNTIME=$((RUNTIME_C+RUNTIME_VAMPIR+RUNTIME_JVT+RUNTIME_CASM))
 
 BACKENDC=$(count src/Juvix/Compiler/Backend/C/)
 CAIRO=$(count src/Juvix/Compiler/Backend/Cairo/)
@@ -62,6 +63,7 @@ echo "   JuvixCore: $CORE LOC"
 echo "Runtime: $RUNTIME LOC"
 echo "   C runtime: $RUNTIME_C LOC"
 echo "   JuvixTree runtime: $RUNTIME_JVT LOC"
+echo "   Cairo assembly runtime: $RUNTIME_CASM LOC"
 echo "   VampIR runtime: $RUNTIME_VAMPIR LOC"
 echo "Other: $OTHER LOC"
 echo "   Application: $APP LOC"
@@ -72,4 +74,4 @@ echo "   Data: $DATA LOC"
 echo "   Prelude: $PRELUDE LOC"
 echo "Tests: $TESTS LOC"
 echo ""
-echo "Total: $TOTAL Haskell LOC + $RUNTIME_C C LOC + $RUNTIME_JVT JuvixTree LOC + $RUNTIME_VAMPIR VampIR LOC"
+echo "Total: $TOTAL Haskell LOC + $RUNTIME_C C LOC + $RUNTIME_JVT JuvixTree LOC + $RUNTIME_CASM CASM LOC + $RUNTIME_VAMPIR VampIR LOC"

package.yaml

@@ -40,6 +40,7 @@ extra-source-files:
   - runtime/**/*.a
   - runtime/src/tree/*.jvt
   - runtime/src/vampir/*.pir
+  - runtime/src/casm/*.casm
 
 dependencies:
   - aeson-better-errors == 0.9.*