2022-09-06 16:26:48 +03:00
|
|
|
module Core.Eval.Base where
|
2022-08-30 12:24:15 +03:00
|
|
|
|
|
|
|
import Base
|
|
|
|
import Data.Text.IO qualified as TIO
|
|
|
|
import Juvix.Compiler.Core.Data.InfoTable
|
|
|
|
import Juvix.Compiler.Core.Error
|
|
|
|
import Juvix.Compiler.Core.Evaluator
|
|
|
|
import Juvix.Compiler.Core.Extra
|
|
|
|
import Juvix.Compiler.Core.Info qualified as Info
|
|
|
|
import Juvix.Compiler.Core.Info.NoDisplayInfo
|
|
|
|
import Juvix.Compiler.Core.Language
|
|
|
|
import Juvix.Compiler.Core.Pretty
|
2022-10-12 11:19:02 +03:00
|
|
|
import Juvix.Compiler.Core.Transformation
|
2022-08-30 12:24:15 +03:00
|
|
|
import Juvix.Compiler.Core.Translation.FromSource
|
|
|
|
import Text.Megaparsec.Pos qualified as M
|
|
|
|
|
2022-10-12 11:19:02 +03:00
|
|
|
coreEvalAssertion ::
|
2022-12-20 15:05:40 +03:00
|
|
|
Path Abs File ->
|
|
|
|
Path Abs File ->
|
2022-10-12 11:19:02 +03:00
|
|
|
[TransformationId] ->
|
|
|
|
(InfoTable -> Assertion) ->
|
|
|
|
(String -> IO ()) ->
|
|
|
|
Assertion
|
|
|
|
coreEvalAssertion mainFile expectedFile trans testTrans step = do
|
2022-08-30 12:24:15 +03:00
|
|
|
step "Parse"
|
|
|
|
r <- parseFile mainFile
|
|
|
|
case r of
|
|
|
|
Left err -> assertFailure (show (pretty err))
|
|
|
|
Right (_, Nothing) -> do
|
|
|
|
step "Compare expected and actual program output"
|
2022-12-20 15:05:40 +03:00
|
|
|
expected <- TIO.readFile (toFilePath expectedFile)
|
|
|
|
assertEqDiff ("Check: EVAL output = " <> toFilePath expectedFile) "" expected
|
2022-10-12 11:19:02 +03:00
|
|
|
Right (tabIni, Just node) -> do
|
2023-01-09 20:21:30 +03:00
|
|
|
let tab = applyTransformations trans (setupMainFunction tabIni node)
|
2022-10-12 11:19:02 +03:00
|
|
|
testTrans tab
|
2023-01-09 20:21:30 +03:00
|
|
|
let node' = fromJust $ tab ^. identContext . at (fromJust $ tab ^. infoMain)
|
2022-12-20 15:05:40 +03:00
|
|
|
withTempDir'
|
2022-08-30 12:24:15 +03:00
|
|
|
( \dirPath -> do
|
2022-12-20 15:05:40 +03:00
|
|
|
let outputFile = dirPath <//> $(mkRelFile "out.out")
|
|
|
|
hout <- openFile (toFilePath outputFile) WriteMode
|
2022-08-30 12:24:15 +03:00
|
|
|
step "Evaluate"
|
2023-01-09 20:21:30 +03:00
|
|
|
r' <- doEval mainFile hout tab node'
|
2022-08-30 12:24:15 +03:00
|
|
|
case r' of
|
|
|
|
Left err -> do
|
|
|
|
hClose hout
|
|
|
|
assertFailure (show (pretty err))
|
|
|
|
Right value -> do
|
|
|
|
unless
|
|
|
|
(Info.member kNoDisplayInfo (getInfo value))
|
|
|
|
(hPutStrLn hout (ppPrint value))
|
|
|
|
hClose hout
|
2022-12-20 15:05:40 +03:00
|
|
|
actualOutput <- TIO.readFile (toFilePath outputFile)
|
2022-08-30 12:24:15 +03:00
|
|
|
step "Compare expected and actual program output"
|
2022-12-20 15:05:40 +03:00
|
|
|
expected <- TIO.readFile (toFilePath expectedFile)
|
|
|
|
assertEqDiff ("Check: EVAL output = " <> toFilePath expectedFile) actualOutput expected
|
2022-08-30 12:24:15 +03:00
|
|
|
)
|
|
|
|
|
2022-12-20 15:05:40 +03:00
|
|
|
coreEvalErrorAssertion :: Path Abs File -> (String -> IO ()) -> Assertion
|
2022-08-30 12:24:15 +03:00
|
|
|
coreEvalErrorAssertion mainFile step = do
|
|
|
|
step "Parse"
|
|
|
|
r <- parseFile mainFile
|
|
|
|
case r of
|
|
|
|
Left _ -> assertBool "" True
|
|
|
|
Right (_, Nothing) -> assertFailure "no error"
|
|
|
|
Right (tab, Just node) -> do
|
2022-12-20 15:05:40 +03:00
|
|
|
withTempDir'
|
2022-08-30 12:24:15 +03:00
|
|
|
( \dirPath -> do
|
2022-12-20 15:05:40 +03:00
|
|
|
let outputFile = dirPath <//> $(mkRelFile "out.out")
|
|
|
|
hout <- openFile (toFilePath outputFile) WriteMode
|
2022-08-30 12:24:15 +03:00
|
|
|
step "Evaluate"
|
|
|
|
r' <- doEval mainFile hout tab node
|
2022-09-29 18:44:55 +03:00
|
|
|
hClose hout
|
2022-08-30 12:24:15 +03:00
|
|
|
case r' of
|
|
|
|
Left _ -> assertBool "" True
|
|
|
|
Right _ -> assertFailure "no error"
|
|
|
|
)
|
|
|
|
|
2022-12-20 15:05:40 +03:00
|
|
|
parseFile :: Path Abs File -> IO (Either ParserError (InfoTable, Maybe Node))
|
2022-08-30 12:24:15 +03:00
|
|
|
parseFile f = do
|
2022-12-20 15:05:40 +03:00
|
|
|
let f' = toFilePath f
|
|
|
|
s <- readFile f'
|
|
|
|
return $ runParser f' emptyInfoTable s
|
2022-08-30 12:24:15 +03:00
|
|
|
|
|
|
|
doEval ::
|
2022-12-20 15:05:40 +03:00
|
|
|
Path Abs File ->
|
2022-08-30 12:24:15 +03:00
|
|
|
Handle ->
|
|
|
|
InfoTable ->
|
|
|
|
Node ->
|
|
|
|
IO (Either CoreError Node)
|
|
|
|
doEval f hout tab node =
|
|
|
|
catchEvalErrorIO defaultLoc (hEvalIO stdin hout (tab ^. identContext) [] node)
|
|
|
|
where
|
2022-12-20 15:05:40 +03:00
|
|
|
defaultLoc = singletonInterval (mkLoc 0 (M.initialPos (toFilePath f)))
|