mirror of
https://github.com/anoma/juvix.git
synced 2024-12-14 17:32:00 +03:00
2d798ec31c
* 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>
50 lines
2.0 KiB
Haskell
50 lines
2.0 KiB
Haskell
module Commands.Dev.Asm.Compile where
|
|
|
|
import Commands.Base
|
|
import Commands.Dev.Asm.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.Translation.FromSource qualified as Asm
|
|
import Juvix.Compiler.Backend qualified as Backend
|
|
import Juvix.Compiler.Backend.C qualified as C
|
|
|
|
runCommand :: forall r. (Members '[Embed IO, App] r) => AsmCompileOptions -> Sem r ()
|
|
runCommand opts = do
|
|
file <- getFile
|
|
s <- embed (readFile (toFilePath file))
|
|
case Asm.runParser (toFilePath file) s of
|
|
Left err -> exitJuvixError (JuvixError err)
|
|
Right tab -> do
|
|
tgt <- asmTarget (opts ^. compileTarget)
|
|
case run $ runError $ asmToMiniC (asmOpts tgt) tab of
|
|
Left err -> exitJuvixError err
|
|
Right C.MiniCResult {..} -> do
|
|
buildDir <- askBuildDir
|
|
ensureDir buildDir
|
|
cFile <- inputCFile file
|
|
embed $ TIO.writeFile (toFilePath cFile) _resultCCode
|
|
Compile.runCommand opts {_compileInputFile = AppPath (Abs cFile) False}
|
|
where
|
|
getFile :: Sem r (Path Abs File)
|
|
getFile = someBaseToAbs' (opts ^. compileInputFile . pathPath)
|
|
|
|
asmOpts :: Backend.Target -> Asm.Options
|
|
asmOpts tgt = Asm.makeOptions tgt (opts ^. compileDebug)
|
|
|
|
asmTarget :: CompileTarget -> Sem r Backend.Target
|
|
asmTarget = \case
|
|
TargetWasm32Wasi -> return Backend.TargetCWasm32Wasi
|
|
TargetNative64 -> return Backend.TargetCNative64
|
|
TargetGeb -> exitMsg (ExitFailure 1) "error: GEB target not supported for JuvixAsm"
|
|
TargetCore -> exitMsg (ExitFailure 1) "error: JuvixCore target not supported for JuvixAsm"
|
|
TargetAsm -> exitMsg (ExitFailure 1) "error: JuvixAsm target not supported for JuvixAsm"
|
|
|
|
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)
|