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

app/Commands/Repl.hs

@@ -12,7 +12,6 @@ import Control.Monad.State.Strict qualified as State
 import Control.Monad.Trans.Class (lift)
 import Control.Monad.Trans.Reader (mapReaderT)
 import Data.String.Interpolate (i, __i)
-import Evaluator
 import HaskelineJB
 import Juvix.Compiler.Concrete.Data.Scope (scopePath)
 import Juvix.Compiler.Concrete.Data.Scope qualified as Scoped
@@ -25,8 +24,6 @@ import Juvix.Compiler.Core.Extra.Value
 import Juvix.Compiler.Core.Info qualified as Info
 import Juvix.Compiler.Core.Info.NoDisplayInfo qualified as Info
 import Juvix.Compiler.Core.Pretty qualified as Core
-import Juvix.Compiler.Core.Transformation qualified as Core
-import Juvix.Compiler.Core.Transformation.DisambiguateNames (disambiguateNames)
 import Juvix.Compiler.Internal.Language qualified as Internal
 import Juvix.Compiler.Internal.Pretty qualified as Internal
 import Juvix.Compiler.Pipeline.Repl
@@ -190,7 +187,7 @@ replCommand opts input_ = catchAll $ do
         doEvalIO' :: Artifacts -> Core.Node -> IO (Either JuvixError Core.Node)
         doEvalIO' artif' n =
           mapLeft (JuvixError @Core.CoreError)
-            <$> doEvalIO False replDefaultLoc (Core.computeCombinedInfoTable $ artif' ^. artifactCoreModule) n
+            <$> Core.doEvalIO False replDefaultLoc (Core.computeCombinedInfoTable $ artif' ^. artifactCoreModule) n
 
         compileString :: Repl (Maybe Core.Node)
         compileString = do
@@ -605,51 +602,3 @@ renderOut = render'
 
 renderOutLn :: (P.HasAnsiBackend a, P.HasTextBackend a) => a -> Repl ()
 renderOutLn t = renderOut t >> replNewline
-
-runTransformations ::
-  forall r.
-  (Members '[State Artifacts, Error JuvixError, Reader EntryPoint] r) =>
-  Bool ->
-  [Core.TransformationId] ->
-  Core.Node ->
-  Sem r Core.Node
-runTransformations shouldDisambiguate ts n = runCoreInfoTableBuilderArtifacts $ do
-  sym <- addNode n
-  applyTransforms shouldDisambiguate ts
-  getNode sym
-  where
-    addNode :: Core.Node -> Sem (Core.InfoTableBuilder ': r) Core.Symbol
-    addNode node = do
-      sym <- Core.freshSymbol
-      Core.registerIdentNode sym node
-      -- `n` will get filtered out by the transformations unless it has a
-      -- corresponding entry in `infoIdentifiers`
-      md <- Core.getModule
-      let name = Core.freshIdentName md "_repl"
-          idenInfo =
-            Core.IdentifierInfo
-              { _identifierName = name,
-                _identifierSymbol = sym,
-                _identifierLocation = Nothing,
-                _identifierArgsNum = 0,
-                _identifierType = Core.mkDynamic',
-                _identifierIsExported = False,
-                _identifierBuiltin = Nothing,
-                _identifierPragmas = mempty,
-                _identifierArgNames = []
-              }
-      Core.registerIdent name idenInfo
-      return sym
-
-    applyTransforms :: Bool -> [Core.TransformationId] -> Sem (Core.InfoTableBuilder ': r) ()
-    applyTransforms shouldDisambiguate' ts' = do
-      md <- Core.getModule
-      md' <- mapReader Core.fromEntryPoint $ Core.applyTransformations ts' md
-      let md'' =
-            if
-                | shouldDisambiguate' -> disambiguateNames md'
-                | otherwise -> md'
-      Core.setModule md''
-
-    getNode :: Core.Symbol -> Sem (Core.InfoTableBuilder ': r) Core.Node
-    getNode sym = fromMaybe impossible . flip Core.lookupIdentifierNode' sym <$> Core.getModule

app/Evaluator.hs

@@ -19,14 +19,6 @@ data EvalOptions = EvalOptions
 
 makeLenses ''EvalOptions
 
-doEvalIO ::
-  Bool ->
-  Interval ->
-  Core.InfoTable ->
-  Core.Node ->
-  IO (Either Core.CoreError Core.Node)
-doEvalIO noIO i tab node = runM (Core.doEval noIO i tab node)
-
 evalAndPrint ::
   forall r a.
   (Members '[EmbedIO, App] r, CanonicalProjection a EvalOptions, CanonicalProjection a Core.Options) =>

src/Juvix/Compiler/Core/Evaluator.hs

@@ -404,6 +404,14 @@ doEval noIO loc tab node
   | noIO = catchEvalError loc (eval stderr (tab ^. identContext) [] node)
   | otherwise = liftIO (catchEvalErrorIO loc (evalIO (tab ^. identContext) [] node))
 
+doEvalIO ::
+  Bool ->
+  Interval ->
+  InfoTable ->
+  Node ->
+  IO (Either CoreError Node)
+doEvalIO noIO i tab node = runM (doEval noIO i tab node)
+
 -- | Catch EvalError and convert it to CoreError. Needs a default location in case
 -- no location is available in EvalError.
 catchEvalError :: (MonadIO m) => Location -> a -> m (Either CoreError a)

src/Juvix/Compiler/Core/Extra/Value.hs

@@ -33,7 +33,7 @@ toValue tab = \case
       ValueConstrApp
         ConstrApp
           { _constrAppName = ci ^. constructorName,
-            _constrAppFixity = ci ^. constructorFixity,
+            _constrAppFixity = Irrelevant (ci ^. constructorFixity),
             _constrAppArgs = map (toValue tab) (drop paramsNum _constrArgs)
           }
       where

src/Juvix/Compiler/Core/Language/Value.hs

@@ -5,9 +5,10 @@ import Juvix.Compiler.Core.Language.Nodes
 
 data ConstrApp = ConstrApp
   { _constrAppName :: Text,
-    _constrAppFixity :: Maybe Fixity,
+    _constrAppFixity :: Irrelevant (Maybe Fixity),
     _constrAppArgs :: [Value]
   }
+  deriving stock (Eq)
 
 -- | Specifies Core values for user-friendly pretty printing.
 data Value
@@ -16,13 +17,14 @@ data Value
   | ValueWildcard
   | ValueFun
   | ValueType
+  deriving stock (Eq)
 
 makeLenses ''ConstrApp
 
 instance HasAtomicity ConstrApp where
   atomicity ConstrApp {..}
     | null _constrAppArgs = Atom
-    | otherwise = Aggregate (fromMaybe appFixity _constrAppFixity)
+    | otherwise = Aggregate (fromMaybe appFixity (_constrAppFixity ^. unIrrelevant))
 
 instance HasAtomicity Value where
   atomicity = \case

src/Juvix/Compiler/Core/Pretty/Base.hs

@@ -608,7 +608,7 @@ goUnary fixity name = \case
 instance PrettyCode ConstrApp where
   ppCode ConstrApp {..} = do
     n <- ppName KNameConstructor _constrAppName
-    case _constrAppFixity of
+    case _constrAppFixity ^. unIrrelevant of
       Nothing -> do
         args <- mapM (ppRightExpression appFixity) _constrAppArgs
         return $ hsep (n : args)

src/Juvix/Compiler/Core/Transformation/MatchToCase.hs

@@ -215,7 +215,7 @@ goMatchToCase recur node = case node of
                   ValueConstrApp
                     ConstrApp
                       { _constrAppName = ci ^. constructorName,
-                        _constrAppFixity = ci ^. constructorFixity,
+                        _constrAppFixity = Irrelevant (ci ^. constructorFixity),
                         _constrAppArgs = replicate argsNum ValueWildcard
                       }
             Nothing ->
@@ -239,7 +239,7 @@ goMatchToCase recur node = case node of
                 ValueConstrApp
                   ConstrApp
                     { _constrAppName = ci ^. constructorName,
-                      _constrAppFixity = ci ^. constructorFixity,
+                      _constrAppFixity = Irrelevant (ci ^. constructorFixity),
                       _constrAppArgs = drop paramsNum (take argsNum args)
                     }
       binders' <- getBranchBinders col matrix tag

src/Juvix/Compiler/Pipeline/Artifacts.hs

@@ -10,6 +10,7 @@ module Juvix.Compiler.Pipeline.Artifacts
 where
 
 import Juvix.Compiler.Builtins
+import Juvix.Compiler.Builtins.Effect qualified as Builtins
 import Juvix.Compiler.Concrete.Data.InfoTableBuilder qualified as Scoped
 import Juvix.Compiler.Concrete.Data.Scope qualified as S
 import Juvix.Compiler.Core.Data.InfoTableBuilder qualified as Core
@@ -26,6 +27,7 @@ import Juvix.Prelude
 appendArtifactsModuleTable :: ModuleTable -> Artifacts -> Artifacts
 appendArtifactsModuleTable mtab =
   over artifactInternalTypedTable (computeCombinedInfoTable importTab <>)
+    . over (artifactBuiltins . Builtins.builtinsTable) (computeCombinedBuiltins mtab <>)
     . over (artifactCoreModule . Core.moduleImportsTable) (computeCombinedCoreInfoTable mtab <>)
     . over artifactModuleTable (mtab <>)
   where

src/Juvix/Compiler/Pipeline/Repl.hs

@@ -6,6 +6,8 @@ import Juvix.Compiler.Concrete.Translation.FromParsed qualified as Scoper
 import Juvix.Compiler.Concrete.Translation.FromSource qualified as Parser
 import Juvix.Compiler.Concrete.Translation.FromSource.ParserResultBuilder (runParserResultBuilder)
 import Juvix.Compiler.Core qualified as Core
+import Juvix.Compiler.Core.Transformation qualified as Core
+import Juvix.Compiler.Core.Transformation.DisambiguateNames (disambiguateNames)
 import Juvix.Compiler.Internal qualified as Internal
 import Juvix.Compiler.Internal.Translation.FromInternal.Analysis.Termination.Checker
 import Juvix.Compiler.Pipeline.Artifacts
@@ -167,3 +169,51 @@ compileReplInputIO fp txt = do
         Parser.ReplExpression e -> ReplPipelineResultNode <$> compileExpression e
         Parser.ReplImport i -> registerImport i $> ReplPipelineResultImport (i ^. importModulePath)
         Parser.ReplOpenImport i -> return (ReplPipelineResultOpen (i ^. openModuleName))
+
+runTransformations ::
+  forall r.
+  (Members '[State Artifacts, Error JuvixError, Reader EntryPoint] r) =>
+  Bool ->
+  [Core.TransformationId] ->
+  Core.Node ->
+  Sem r Core.Node
+runTransformations shouldDisambiguate ts n = runCoreInfoTableBuilderArtifacts $ do
+  sym <- addNode n
+  applyTransforms shouldDisambiguate ts
+  getNode sym
+  where
+    addNode :: Core.Node -> Sem (Core.InfoTableBuilder ': r) Core.Symbol
+    addNode node = do
+      sym <- Core.freshSymbol
+      Core.registerIdentNode sym node
+      -- `n` will get filtered out by the transformations unless it has a
+      -- corresponding entry in `infoIdentifiers`
+      md <- Core.getModule
+      let name = Core.freshIdentName md "_repl"
+          idenInfo =
+            Core.IdentifierInfo
+              { _identifierName = name,
+                _identifierSymbol = sym,
+                _identifierLocation = Nothing,
+                _identifierArgsNum = 0,
+                _identifierType = Core.mkDynamic',
+                _identifierIsExported = False,
+                _identifierBuiltin = Nothing,
+                _identifierPragmas = mempty,
+                _identifierArgNames = []
+              }
+      Core.registerIdent name idenInfo
+      return sym
+
+    applyTransforms :: Bool -> [Core.TransformationId] -> Sem (Core.InfoTableBuilder ': r) ()
+    applyTransforms shouldDisambiguate' ts' = do
+      md <- Core.getModule
+      md' <- mapReader Core.fromEntryPoint $ Core.applyTransformations ts' md
+      let md'' =
+            if
+                | shouldDisambiguate' -> disambiguateNames md'
+                | otherwise -> md'
+      Core.setModule md''
+
+    getNode :: Core.Symbol -> Sem (Core.InfoTableBuilder ': r) Core.Node
+    getNode sym = fromMaybe impossible . flip Core.lookupIdentifierNode' sym <$> Core.getModule

src/Juvix/Compiler/Store/Extra.hs

@@ -1,9 +1,11 @@
 module Juvix.Compiler.Store.Extra where
 
 import Data.HashMap.Strict qualified as HashMap
+import Juvix.Compiler.Concrete.Data.Builtins
 import Juvix.Compiler.Concrete.Data.ScopedName qualified as S
 import Juvix.Compiler.Concrete.Language (TopModulePath)
 import Juvix.Compiler.Core.Data.InfoTable qualified as Core
+import Juvix.Compiler.Internal.Data.Name
 import Juvix.Compiler.Store.Core.Extra
 import Juvix.Compiler.Store.Internal.Language
 import Juvix.Compiler.Store.Language
@@ -42,3 +44,9 @@ computeCombinedScopedInfoTable mtab =
 computeCombinedCoreInfoTable :: ModuleTable -> Core.InfoTable
 computeCombinedCoreInfoTable mtab =
   mconcatMap (toCore . (^. moduleInfoCoreTable)) (HashMap.elems (mtab ^. moduleTable))
+
+computeCombinedBuiltins :: ModuleTable -> HashMap BuiltinPrim Name
+computeCombinedBuiltins mtab =
+  mconcatMap
+    (^. moduleInfoInternalModule . internalModuleInfoTable . infoBuiltins)
+    (HashMap.elems (mtab ^. moduleTable))

src/Juvix/Data/Error/GenericError.hs

@@ -74,6 +74,9 @@ render ansi endChar err = do
 renderText :: (ToGenericError e, Member (Reader GenericOptions) r) => e -> Sem r Text
 renderText = render False False
 
+renderTextDefault :: (ToGenericError e) => e -> Text
+renderTextDefault = run . runReader defaultGenericOptions . renderText
+
 -- | Render the error with Ansi formatting (if any).
 renderAnsiText :: (ToGenericError e, Member (Reader GenericOptions) r) => e -> Sem r Text
 renderAnsiText = render True False

test/Main.hs

@@ -16,6 +16,7 @@ import Nockma qualified
 import Package qualified
 import Parsing qualified
 import Reg qualified
+import Repl qualified
 import Resolver qualified
 import Runtime qualified
 import Scope qualified
@@ -39,7 +40,8 @@ slowTests =
       Examples.allTests,
       Casm.allTests,
       VampIR.allTests,
-      Anoma.allTests
+      Anoma.allTests,
+      Repl.allTests
     ]
 
 fastTests :: TestTree

test/Repl.hs

@@ -0,0 +1,7 @@
+module Repl where
+
+import Base
+import Repl.Positive qualified as P
+
+allTests :: TestTree
+allTests = testGroup "Juvix REPL tests" [P.allTests]

test/Repl/Assertions.hs

@@ -0,0 +1,21 @@
+module Repl.Assertions where
+
+import Base
+import Juvix.Compiler.Core qualified as Core
+import Juvix.Compiler.Core.Language.Value qualified as Core
+import Juvix.Compiler.Core.Pretty qualified as Core
+
+assertNoJuvixError :: Either JuvixError a -> IO a
+assertNoJuvixError = either (assertFailure . ("JuvixError: " <>) . unpack . renderTextDefault) return
+
+assertPrettyCodeEqual :: (Core.PrettyCode a, Eq a) => a -> a -> Assertion
+assertPrettyCodeEqual expected actual = unless (expected == actual) (assertFailure (unpack msg))
+  where
+    msg :: Text
+    msg = "expected: " <> Core.ppTrace expected <> "\n but got: " <> Core.ppTrace actual
+
+assertNodeEqual :: Core.Node -> Core.Node -> Assertion
+assertNodeEqual = assertPrettyCodeEqual
+
+assertValueEqual :: Core.Value -> Core.Value -> Assertion
+assertValueEqual = assertPrettyCodeEqual

test/Repl/Positive.hs

@@ -0,0 +1,139 @@
+module Repl.Positive where
+
+import Base
+import Juvix.Compiler.Core qualified as Core
+import Juvix.Compiler.Core.Extra.Value qualified as Core
+import Juvix.Compiler.Core.Language.Value qualified as Core
+import Juvix.Compiler.Core.Transformation
+import Juvix.Compiler.Pipeline.Repl
+import Juvix.Compiler.Pipeline.Root
+import Juvix.Data.Effect.TaggedLock
+import Juvix.Extra.Paths qualified as P
+import Juvix.Extra.Stdlib
+import Repl.Assertions
+import Repl.Value
+
+runTaggedLockIO' :: Sem '[Files, TaggedLock, Embed IO] a -> IO a
+runTaggedLockIO' =
+  runM
+    . runTaggedLockPermissive
+    . runFilesIO
+
+loadPrelude :: Path Abs Dir -> IO (Artifacts, EntryPoint)
+loadPrelude rootDir = runTaggedLockIO' $ do
+  runReader rootDir writeStdlib
+  pkg <- readPackageRootIO root
+  let ep = defaultEntryPoint pkg root (rootDir <//> preludePath)
+  artif <- embed (runReplPipelineIO ep)
+  return (artif, ep)
+  where
+    root :: Root
+    root =
+      Root
+        { _rootRootDir = rootDir,
+          _rootPackageType = LocalPackage,
+          _rootInvokeDir = rootDir,
+          _rootBuildDir = DefaultBuildDir
+        }
+
+data TestCtx = TestCtx
+  { _testCtxRootDir :: Path Abs Dir,
+    _testCtxEntryPoint :: EntryPoint,
+    _testCtxArtifacts :: Artifacts
+  }
+
+data PosTest = PosTest
+  { _posTestName :: Text,
+    _posTestInput :: Text,
+    _posTestExpected :: Core.Value
+  }
+
+makeLenses ''TestCtx
+makeLenses ''PosTest
+
+mkPreludeTest :: IO TestCtx -> PosTest -> TestTree
+mkPreludeTest getCtx p = testCase (unpack (p ^. posTestName)) (replTest (p ^. posTestInput) (p ^. posTestExpected) getCtx)
+
+replSetup :: IO TestCtx
+replSetup = do
+  _testCtxRootDir <- do
+    sysTemp <- getTempDir
+    createTempDir sysTemp "repl"
+  (_testCtxArtifacts, _testCtxEntryPoint) <- loadPrelude _testCtxRootDir
+  return TestCtx {..}
+
+replTeardown :: TestCtx -> IO ()
+replTeardown = removeDirRecur . (^. testCtxRootDir)
+
+replTest :: Text -> Core.Value -> IO TestCtx -> IO ()
+replTest input' expectedNode getTestCtx = do
+  ctx <- getTestCtx
+  (artif, res) <- compileReplInputIO' ctx input'
+  res' <- assertNoJuvixError res
+  case res' of
+    Nothing -> assertFailure "Compilation did not return a node"
+    Just n -> do
+      let ep = ctx ^. testCtxEntryPoint
+      n' <- evalRepl artif ep n
+      assertValueEqual expectedNode n'
+
+allTests :: TestTree
+allTests =
+  testGroup
+    "REPL positive tests"
+    [ withResource
+        replSetup
+        replTeardown
+        ( \getCtx ->
+            testGroup
+              "Loading Stdlib.Prelude"
+              ( map
+                  (mkPreludeTest getCtx)
+                  [ PosTest "Arithmetic" "3 * (1 + 1)" (mkInteger 6),
+                    PosTest "Logic And" "true && false" (mkBool False),
+                    PosTest "Let" "let x : Nat := 2 + 1 in x" (mkInteger 3),
+                    PosTest "Literal comparison" "1 == 1" (mkBool True),
+                    PosTest "List literal in call" "head 0 [1;2;3]" (mkInteger 1)
+                  ]
+              )
+        )
+    ]
+
+compileReplInputIO' :: TestCtx -> Text -> IO (Artifacts, (Either JuvixError (Maybe Core.Node)))
+compileReplInputIO' ctx txt =
+  runM
+    . runState (ctx ^. testCtxArtifacts)
+    . runReader (ctx ^. testCtxEntryPoint)
+    $ do
+      r <- compileReplInputIO P.replPath txt
+      return (extractNode <$> r)
+  where
+    extractNode :: ReplPipelineResult -> Maybe Core.Node
+    extractNode = \case
+      ReplPipelineResultNode n -> Just n
+      ReplPipelineResultImport {} -> Nothing
+      ReplPipelineResultOpen {} -> Nothing
+
+evalRepl :: Artifacts -> EntryPoint -> Core.Node -> IO Core.Value
+evalRepl artif ep n = do
+  (artif', n') <-
+    assertNoJuvixError
+      . run
+      . runReader ep
+      . runError @JuvixError
+      . runState artif
+      . runTransformations True toStoredTransformations
+      $ n
+  doEvalIO' artif' n' >>= assertNoJuvixError
+  where
+    doEvalIO' :: Artifacts -> Core.Node -> IO (Either JuvixError Core.Value)
+    doEvalIO' artif' n' =
+      mapRight (Core.toValue tab)
+        . mapLeft (JuvixError @Core.CoreError)
+        <$> (Core.doEvalIO False replDefaultLoc tab n')
+      where
+        tab :: Core.InfoTable
+        tab = Core.computeCombinedInfoTable $ artif' ^. artifactCoreModule
+
+    replDefaultLoc :: Interval
+    replDefaultLoc = singletonInterval (mkInitialLoc P.replPath)

test/Repl/Value.hs

@@ -0,0 +1,24 @@
+module Repl.Value where
+
+import Base
+import Juvix.Compiler.Core qualified as Core
+import Juvix.Compiler.Core.Language.Value qualified as Core
+import Juvix.Extra.Strings qualified as Str
+
+mkInteger :: Integer -> Core.Value
+mkInteger = Core.ValueConstant . Core.ConstInteger
+
+mkBool :: Bool -> Core.Value
+mkBool b =
+  Core.ValueConstrApp
+    ( Core.ConstrApp
+        { _constrAppName = name,
+          _constrAppFixity = Irrelevant Nothing,
+          _constrAppArgs = []
+        }
+    )
+  where
+    name :: Text
+    name = case b of
+      True -> Str.true
+      False -> Str.false

tests/smoke/Commands/repl.smoke.yaml

@@ -227,16 +227,6 @@ tests:
           Nat
     exit-status: 0
 
-  - name: eval-let-expression
-    command:
-      - juvix
-      - repl
-    stdin: "let x : Nat := 2 + 1 in x"
-    stdout:
-      contains:
-        "3"
-    exit-status: 0
-
   - name: load-builtin-bool
     command:
       shell:
@@ -299,16 +289,6 @@ tests:
         Stdlib.Prelude> .*/global-project/
     exit-status: 0
 
-  - name: eval-adding-two-literal-nats
-    command:
-      - juvix
-      - repl
-    stdin: "1 + 2"
-    stdout:
-      contains: |
-        3
-    exit-status: 0
-
   - name: repl-trace
     command:
       - juvix
@@ -453,16 +433,6 @@ tests:
       contains: "true"
     exit-status: 0
 
-  - name: literal-comparison
-    command:
-      - juvix
-      - repl
-    stdin: |
-      1 == 1
-    stdout:
-      contains: "true"
-    exit-status: 0
-
   - name: open-import-from-stdlib
     command:
       - juvix