mirror of
https://github.com/anoma/juvix.git
synced 2024-12-20 21:31:48 +03:00
8aa54ecc28
* Closes #1989 * Adds optimization phases to the pipline (specified by `opt-phase-eval`, `opt-phase-exec` and `opt-phase-geb` transformations). * Adds the `-O` option to the `compile` command to specify the optimization level. * Functions can be declared for inlining with the `inline` pragma: ``` {-# inline: true #-} const : {A B : Type} -> A -> B -> A; const x _ := x; ``` By default, the function is inlined only if it's fully applied. One can specify that a function (partially) applied to at least `n` explicit arguments should be inlined. ``` {-# inline: 2 #-} compose : {A B C : Type} -> (B -> C) -> (A -> B) -> A -> C; compose f g x := f (g x); ``` Then `compose f g` will be inlined, even though it's not fully applied. But `compose f` won't be inlined. * Non-recursive fully applied functions are automatically inlined if the height of the body term does not exceed the inlining depth limit, which can be specified with the `--inline` option to the `compile` command. * The pragma `inline: false` disables automatic inlining on a per-function basis.
90 lines
3.5 KiB
Haskell
90 lines
3.5 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.Pretty qualified as Asm
|
|
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
|
|
}
|
|
|
|
getEntry :: Members '[Embed IO, App] r => PipelineArg -> Sem r EntryPoint
|
|
getEntry PipelineArg {..} = do
|
|
ep <- getEntryPoint (AppPath (preFileFromAbs _pipelineArgFile) True)
|
|
return $
|
|
ep
|
|
{ _entryPointTarget = getTarget (_pipelineArgOptions ^. compileTarget),
|
|
_entryPointDebug = _pipelineArgOptions ^. compileDebug,
|
|
_entryPointOptimizationLevel = _pipelineArgOptions ^. compileOptimizationLevel,
|
|
_entryPointInliningDepth = _pipelineArgOptions ^. compileInliningDepth
|
|
}
|
|
where
|
|
getTarget :: CompileTarget -> Backend.Target
|
|
getTarget = \case
|
|
TargetWasm32Wasi -> Backend.TargetCWasm32Wasi
|
|
TargetNative64 -> Backend.TargetCNative64
|
|
TargetGeb -> Backend.TargetGeb
|
|
TargetCore -> Backend.TargetCore
|
|
TargetAsm -> Backend.TargetAsm
|
|
|
|
runCPipeline ::
|
|
forall r.
|
|
(Members '[Embed IO, App] r) =>
|
|
PipelineArg ->
|
|
Sem r ()
|
|
runCPipeline pa@PipelineArg {..} = do
|
|
entryPoint <- getEntry pa
|
|
C.MiniCResult {..} <- getRight (run (runReader entryPoint (runError (coreToMiniC _pipelineArgInfoTable :: Sem '[Error JuvixError, Reader EntryPoint] C.MiniCResult))))
|
|
cFile <- inputCFile _pipelineArgFile
|
|
embed $ TIO.writeFile (toFilePath cFile) _resultCCode
|
|
outfile <- Compile.outputFile _pipelineArgOptions _pipelineArgFile
|
|
Compile.runCommand
|
|
_pipelineArgOptions
|
|
{ _compileInputFile = 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))
|
|
|
|
runGebPipeline ::
|
|
forall r.
|
|
(Members '[Embed IO, App] r) =>
|
|
PipelineArg ->
|
|
Sem r ()
|
|
runGebPipeline pa@PipelineArg {..} = do
|
|
entryPoint <- getEntry pa
|
|
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 (runReader entryPoint (runError (coreToGeb spec _pipelineArgInfoTable :: Sem '[Error JuvixError, Reader EntryPoint] Geb.Result))))
|
|
embed $ TIO.writeFile (toFilePath gebFile) _resultCode
|
|
|
|
runAsmPipeline :: (Members '[Embed IO, App] r) => PipelineArg -> Sem r ()
|
|
runAsmPipeline pa@PipelineArg {..} = do
|
|
entryPoint <- getEntry pa
|
|
asmFile <- Compile.outputFile _pipelineArgOptions _pipelineArgFile
|
|
r <- runReader entryPoint $ runError @JuvixError (coreToAsm _pipelineArgInfoTable)
|
|
tab' <- getRight r
|
|
let code = Asm.ppPrint tab' tab'
|
|
embed $ TIO.writeFile (toFilePath asmFile) code
|