1
1
mirror of https://github.com/anoma/juvix.git synced 2024-12-14 08:27:03 +03:00
juvix/app/Evaluator.hs
Paul Cadman a091a7f63d
Update REPL artifacts with builtins from stored modules (#2639)
Builtin information needs to be propagated from stored modules to REPL
artifacts to avoid "The builtin _ has not been defined" errors.

This PR adds a test suite for the REPL in the Haskell test code. This
means some of the slow smoke tests can be moved to fast haskell unit
tests. In future we should refactor the REPL code by putting in the main
src target and unit testing more features (e.g :doc, :def).

* Closes https://github.com/anoma/juvix/issues/2638
2024-02-26 16:19:04 +00:00

68 lines
2.2 KiB
Haskell

module Evaluator where
import App
import CommonOptions
import Juvix.Compiler.Core qualified as Core
import Juvix.Compiler.Core.Extra.Value qualified as Core
import Juvix.Compiler.Core.Info qualified as Info
import Juvix.Compiler.Core.Info.NoDisplayInfo qualified as Info
import Juvix.Compiler.Core.Normalizer
import Juvix.Compiler.Core.Pretty qualified as Core
import Juvix.Compiler.Core.Transformation.DisambiguateNames qualified as Core
data EvalOptions = EvalOptions
{ _evalInputFile :: AppPath File,
_evalNoIO :: Bool,
_evalNoDisambiguate :: Bool,
_evalPrintValues :: Bool
}
makeLenses ''EvalOptions
evalAndPrint ::
forall r a.
(Members '[EmbedIO, App] r, CanonicalProjection a EvalOptions, CanonicalProjection a Core.Options) =>
a ->
Core.InfoTable ->
Core.Node ->
Sem r ()
evalAndPrint opts tab node = do
loc <- defaultLoc
r <- Core.doEval (project opts ^. evalNoIO) loc tab node
case r of
Left err -> exitJuvixError (JuvixError err)
Right node'
| Info.member Info.kNoDisplayInfo (Core.getInfo node') ->
return ()
Right node'
| project opts ^. evalPrintValues -> do
renderStdOut (Core.ppOut opts (Core.toValue tab node'))
newline
| otherwise -> do
renderStdOut (Core.ppOut opts node'')
newline
where
node'' = if project opts ^. evalNoDisambiguate then node' else Core.disambiguateNodeNames (Core.moduleFromInfoTable tab) node'
where
defaultLoc :: Sem r Interval
defaultLoc = singletonInterval . mkInitialLoc <$> fromAppPathFile f
f :: AppPath File
f = project opts ^. evalInputFile
normalizeAndPrint ::
forall r a.
(Members '[EmbedIO, App] r, CanonicalProjection a EvalOptions, CanonicalProjection a Core.Options) =>
a ->
Core.InfoTable ->
Core.Node ->
Sem r ()
normalizeAndPrint opts tab node =
let node' = normalize (Core.moduleFromInfoTable tab) node
in if
| Info.member Info.kNoDisplayInfo (Core.getInfo node') ->
return ()
| otherwise -> do
let node'' = if project opts ^. evalNoDisambiguate then node' else Core.disambiguateNodeNames (Core.moduleFromInfoTable tab) node'
renderStdOut (Core.ppOut opts node'')
putStrLn ""