1
1
mirror of https://github.com/anoma/juvix.git synced 2025-01-08 16:51:53 +03:00
juvix/test/BackendGeb/Eval/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.6 KiB
Haskell

module BackendGeb.Eval.Base where
import Base
import Data.Text.IO qualified as TIO
import Juvix.Compiler.Backend.Geb qualified as Geb
import Juvix.Prelude.Pretty
gebEvalAssertion ::
Path Abs File ->
Path Abs File ->
(String -> IO ()) ->
Assertion
gebEvalAssertion mainFile expectedFile step = do
step "Parse"
input <- readFile (toFilePath mainFile)
case Geb.runParser mainFile input of
Left err -> assertFailure (show (pretty err))
Right (Geb.ExpressionObject _) -> do
step "No evaluation for objects"
assertFailure (unpack Geb.objNoEvalMsg)
Right (Geb.ExpressionMorphism gebMorphism) ->
gebEvalAssertion' mainFile expectedFile step gebMorphism
Right (Geb.ExpressionTypedMorphism typedMorphism) ->
gebEvalAssertion'
mainFile
expectedFile
step
(typedMorphism ^. Geb.typedMorphism)
gebEvalAssertion' ::
Path Abs File ->
Path Abs File ->
(String -> IO ()) ->
Geb.Morphism ->
Assertion
gebEvalAssertion' _mainFile expectedFile step gebMorphism = do
let env :: Geb.Env =
Geb.Env
{ _envEvaluatorOptions = Geb.defaultEvaluatorOptions,
_envContext = mempty
}
withTempDir' $
\dirPath -> do
let outputFile = dirPath <//> $(mkRelFile "out.out")
step "Evaluate"
hout <- openFile (toFilePath outputFile) WriteMode
let result = Geb.eval' env gebMorphism
case result of
Left err -> do
hClose hout
assertFailure (show (pretty (fromJuvixError @GenericError err)))
Right value -> do
hPutStrLn hout (Geb.ppPrint value)
hClose hout
actualOutput <- TIO.readFile (toFilePath outputFile)
expected <- TIO.readFile (toFilePath expectedFile)
step "Compare expected and actual program output"
assertEqDiffText
("Check: EVAL output = " <> toFilePath expectedFile)
actualOutput
expected
gebEvalErrorAssertion :: Path Abs File -> (String -> IO ()) -> Assertion
gebEvalErrorAssertion mainFile step = do
step "Parse"
input <- readFile (toFilePath mainFile)
case Geb.runParser mainFile input of
Left _ -> assertBool "" True
Right (Geb.ExpressionObject _) -> assertFailure "no error"
Right morph' -> do
step "Evaluate"
let gebMorphism = case morph' of
Geb.ExpressionMorphism morph -> morph
Geb.ExpressionTypedMorphism typedMorphism ->
typedMorphism ^. Geb.typedMorphism
case Geb.eval' Geb.defaultEvalEnv gebMorphism of
Left _ -> assertBool "" True
Right _ -> assertFailure "no error"