mirror of
https://github.com/anoma/juvix.git
synced 2024-12-20 21:31:48 +03:00
ac6d08e259
* Depends on #1832 * Closes #1844 * Adds errors to the Core pipeline * Checks for no recursion in the GEB pipeline * Checks for no polymorphism in the GEB pipeline * Checks for no dynamic type in the GEB pipeline * Checks for no IO in the GEB pipeline * Checks for no unsupported builtins in the GEB pipeline
80 lines
3.0 KiB
Haskell
80 lines
3.0 KiB
Haskell
module Commands.Dev.Core.Compile.Base where
|
|
|
|
import Commands.Base
|
|
import Commands.Dev.Core.Compile.Options
|
|
import Commands.Extra.Compile qualified as Compile
|
|
import Data.Text.IO qualified as TIO
|
|
import Juvix.Compiler.Asm.Options qualified as Asm
|
|
import Juvix.Compiler.Asm.Pretty qualified as Pretty
|
|
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.Core.Data.InfoTable qualified as Core
|
|
import System.FilePath (takeBaseName)
|
|
|
|
data PipelineArg = PipelineArg
|
|
{ _pipelineArgOptions :: CompileOptions,
|
|
_pipelineArgFile :: Path Abs File,
|
|
_pipelineArgInfoTable :: Core.InfoTable
|
|
}
|
|
|
|
runCPipeline ::
|
|
forall r.
|
|
(Members '[Embed IO, App] r) =>
|
|
PipelineArg ->
|
|
Sem r ()
|
|
runCPipeline PipelineArg {..} = do
|
|
C.MiniCResult {..} <- getRight (run (runError (coreToMiniC asmOpts _pipelineArgInfoTable :: Sem '[Error JuvixError] C.MiniCResult)))
|
|
cFile <- inputCFile _pipelineArgFile
|
|
embed $ TIO.writeFile (toFilePath cFile) _resultCCode
|
|
outfile <- Compile.outputFile _pipelineArgOptions _pipelineArgFile
|
|
Compile.runCommand
|
|
_pipelineArgOptions
|
|
{ _compileInputFile = AppPath (Abs cFile) False,
|
|
_compileOutputFile = Just (AppPath (Abs outfile) False)
|
|
}
|
|
where
|
|
asmOpts :: Asm.Options
|
|
asmOpts = Asm.makeOptions (asmTarget (_pipelineArgOptions ^. compileTarget)) (_pipelineArgOptions ^. compileDebug)
|
|
|
|
asmTarget :: CompileTarget -> Backend.Target
|
|
asmTarget = \case
|
|
TargetWasm32Wasi -> Backend.TargetCWasm32Wasi
|
|
TargetNative64 -> Backend.TargetCNative64
|
|
TargetGeb -> impossible
|
|
TargetCore -> impossible
|
|
TargetAsm -> impossible
|
|
|
|
inputCFile :: Path Abs File -> Sem r (Path Abs File)
|
|
inputCFile inputFileCompile = do
|
|
buildDir <- askBuildDir
|
|
ensureDir buildDir
|
|
return (buildDir <//> replaceExtension' ".c" (filename inputFileCompile))
|
|
|
|
runGebPipeline ::
|
|
forall r.
|
|
(Members '[Embed IO, App] r) =>
|
|
PipelineArg ->
|
|
Sem r ()
|
|
runGebPipeline PipelineArg {..} = do
|
|
gebFile <- Compile.outputFile _pipelineArgOptions _pipelineArgFile
|
|
let spec =
|
|
if
|
|
| _pipelineArgOptions ^. compileTerm -> Geb.OnlyTerm
|
|
| otherwise ->
|
|
Geb.LispPackage
|
|
Geb.LispPackageSpec
|
|
{ _lispPackageName = fromString $ takeBaseName $ toFilePath gebFile,
|
|
_lispPackageEntry = "*entry*"
|
|
}
|
|
Geb.Result {..} <- getRight (run (runError (coreToGeb spec _pipelineArgInfoTable :: Sem '[Error JuvixError] Geb.Result)))
|
|
embed $ TIO.writeFile (toFilePath gebFile) _resultCode
|
|
|
|
runAsmPipeline :: (Members '[Embed IO, App] r) => PipelineArg -> Sem r ()
|
|
runAsmPipeline PipelineArg {..} = do
|
|
asmFile <- Compile.outputFile _pipelineArgOptions _pipelineArgFile
|
|
r <- runError @JuvixError (coreToAsm _pipelineArgInfoTable)
|
|
tab' <- getRight r
|
|
let code = Pretty.ppPrint tab' tab'
|
|
embed $ TIO.writeFile (toFilePath asmFile) code
|