1
1
mirror of https://github.com/anoma/juvix.git synced 2024-12-20 21:31:48 +03:00
juvix/app/Commands/Dev/Core/Compile/Base.hs
Łukasz Czajka 2d798ec31c
New compilation pipeline (#1832)
* Depends on PR #1824 
* Closes #1556 
* Closes #1825 
* Closes #1843
* Closes #1729 
* Closes #1596 
* Closes #1343 
* Closes #1382 
* Closes #1867 
* Closes #1876 
* Changes the `juvix compile` command to use the new pipeline.
* Removes the `juvix dev minic` command and the `BackendC` tests.
* Adds the `juvix eval` command.
* Fixes bugs in the Nat-to-integer conversion.
* Fixes bugs in the Internal-to-Core and Core-to-Core.Stripped
translations.
* Fixes bugs in the RemoveTypeArgs transformation.
* Fixes bugs in lambda-lifting (incorrect de Bruijn indices in the types
of added binders).
* Fixes several other bugs in the compilation pipeline.
* Adds a separate EtaExpandApps transformation to avoid quadratic
runtime in the Internal-to-Core translation due to repeated calls to
etaExpandApps.
* Changes Internal-to-Core to avoid generating matches on values which
don't have an inductive type.

---------

Co-authored-by: Paul Cadman <git@paulcadman.dev>
Co-authored-by: janmasrovira <janmasrovira@gmail.com>
2023-03-14 16:24:07 +01:00

79 lines
2.9 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
let tab' = coreToAsm _pipelineArgInfoTable
code = Pretty.ppPrint tab' tab'
embed $ TIO.writeFile (toFilePath asmFile) code