Evaluate Nockma scry/op12 and add a test

src/Juvix/Compiler/Nockma/EvalCompiled.hs

@@ -10,6 +10,7 @@ evalCompiledNock' stack mainTerm = do
   evalT <-
     runError @(ErrNockNatural Natural)
       . runError @(NockEvalError Natural)
+      . runReader @(Storage Natural) emptyStorage
       $ eval stack mainTerm
   case evalT of
     Left e -> error (show e)

src/Juvix/Compiler/Nockma/Evaluator.hs

@@ -2,11 +2,14 @@ module Juvix.Compiler.Nockma.Evaluator
   ( module Juvix.Compiler.Nockma.Evaluator,
     module Juvix.Compiler.Nockma.Evaluator.Error,
     module Juvix.Compiler.Nockma.Evaluator.Options,
+    module Juvix.Compiler.Nockma.Evaluator.Storage,
   )
 where
 
+import Data.HashMap.Strict qualified as HashMap
 import Juvix.Compiler.Nockma.Evaluator.Error
 import Juvix.Compiler.Nockma.Evaluator.Options
+import Juvix.Compiler.Nockma.Evaluator.Storage
 import Juvix.Compiler.Nockma.Language
 import Juvix.Prelude hiding (Atom, Path)
 
@@ -102,7 +105,7 @@ programAssignments mprog =
 -- | The stack provided in the replExpression has priority
 evalRepl ::
   forall r a.
-  (Integral a, Members '[Reader EvalOptions, Error (NockEvalError a), Error (ErrNockNatural a)] r, NockNatural a) =>
+  (Hashable a, Integral a, Members '[Reader EvalOptions, Error (NockEvalError a), Error (ErrNockNatural a)] r, NockNatural a) =>
   (Term a -> Sem r ()) ->
   Maybe (Program a) ->
   Maybe (Term a) ->
@@ -115,7 +118,7 @@ evalRepl handleTrace mprog defaultStack expr = do
       t' <- fromReplTerm namedTerms (w ^. withStackStack)
       return (Just t', w ^. withStackTerm)
   stack <- maybe errNoStack return mstack
-  fromReplTerm namedTerms t >>= runOutputSem @(Term a) handleTrace . eval stack
+  fromReplTerm namedTerms t >>= runOutputSem @(Term a) handleTrace . runReader @(Storage a) emptyStorage . eval stack
   where
     errNoStack :: Sem r x
     errNoStack = throw @(NockEvalError a) (ErrNoStack NoStack)
@@ -125,7 +128,7 @@ evalRepl handleTrace mprog defaultStack expr = do
 
 eval ::
   forall s a.
-  (Integral a, Members '[Reader EvalOptions, Output (Term a), Error (NockEvalError a), Error (ErrNockNatural a)] s, NockNatural a) =>
+  (Hashable a, Integral a, Members '[Reader (Storage a), Reader EvalOptions, Output (Term a), Error (NockEvalError a), Error (ErrNockNatural a)] s, NockNatural a) =>
   Term a ->
   Term a ->
   Sem s (Term a)
@@ -210,6 +213,7 @@ eval inistack initerm =
           OpCall -> goOpCall
           OpReplace -> goOpReplace
           OpHint -> goOpHint
+          OpScry -> goOpScry
           OpTrace -> goOpTrace
           where
             crumb crumbTag =
@@ -317,3 +321,10 @@ eval inistack initerm =
               cellTerm <- withCrumb (crumb crumbDecodeFirst) (asCell (c ^. operatorCellTerm))
               t1' <- evalArg crumbEvalFirst stack (cellTerm ^. cellLeft)
               evalArg crumbEvalSecond t1' (cellTerm ^. cellRight)
+
+            goOpScry :: Sem r (Term a)
+            goOpScry = do
+              Cell' typeFormula subFormula _ <- withCrumb (crumb crumbDecodeFirst) (asCell (c ^. operatorCellTerm))
+              void (evalArg crumbEvalFirst stack typeFormula)
+              subResult <- evalArg crumbEvalSecond stack subFormula
+              HashMap.lookupDefault impossible subResult <$> asks (^. storageKeyValueData)

src/Juvix/Compiler/Nockma/Evaluator/Storage.hs

@@ -0,0 +1,12 @@
+module Juvix.Compiler.Nockma.Evaluator.Storage where
+
+import Juvix.Compiler.Nockma.Language
+import Juvix.Prelude.Base
+
+newtype Storage a = Storage
+  {_storageKeyValueData :: HashMap (Term a) (Term a)}
+
+emptyStorage :: (Hashable a) => Storage a
+emptyStorage = Storage {_storageKeyValueData = mempty}
+
+makeLenses ''Storage

test/Anoma/Compilation/Positive.hs

@@ -27,6 +27,7 @@ mkAnomaCallTest' enableDebug _testName relRoot mainFile args _testCheck =
         return compiledMain
       let _testProgramFormula = anomaCall args
           _testEvalOptions = defaultEvalOptions
+          _testProgramStorage :: Storage Natural = emptyStorage
       return Test {..}
 
     withRootCopy :: (Prelude.Path Abs Dir -> IO a) -> IO a

test/Nockma/Eval/Positive.hs

@@ -1,6 +1,7 @@
 module Nockma.Eval.Positive where
 
 import Base hiding (Path, testName)
+import Data.HashMap.Strict qualified as HashMap
 import Juvix.Compiler.Core.Language.Base (defaultSymbol)
 import Juvix.Compiler.Nockma.Evaluator
 import Juvix.Compiler.Nockma.Language
@@ -13,6 +14,7 @@ type Check = Sem '[Reader [Term Natural], Reader (Term Natural), EmbedIO]
 
 data Test = Test
   { _testEvalOptions :: EvalOptions,
+    _testProgramStorage :: Storage Natural,
     _testName :: Text,
     _testProgramSubject :: Term Natural,
     _testProgramFormula :: Term Natural,
@@ -29,6 +31,7 @@ mkNockmaAssertion Test {..} = do
           . runOutputList @(Term Natural)
           . runError @(ErrNockNatural Natural)
           . runError @(NockEvalError Natural)
+          . runReader @(Storage Natural) _testProgramStorage
           $ eval _testProgramSubject _testProgramFormula
 
   case evalResult of
@@ -91,6 +94,7 @@ compilerTest n mainFun _testCheck _evalInterceptStdlibCalls =
       opts = CompilerOptions {_compilerOptionsEnableTrace = False}
       Cell _testProgramSubject _testProgramFormula = runCompilerWithJuvix opts mempty [] f
       _testEvalOptions = EvalOptions {..}
+      _testProgramStorage :: Storage Natural = emptyStorage
    in Test {..}
 
 anomaTest :: Text -> Term Natural -> [Term Natural] -> Check () -> Bool -> Test
@@ -110,11 +114,15 @@ anomaTest n mainFun args _testCheck _evalInterceptStdlibCalls =
       _testProgramSubject = TermCell (runCompilerWithAnoma opts mempty [] f)
 
       _testProgramFormula = anomaCall args
+      _testProgramStorage :: Storage Natural = emptyStorage
       _testEvalOptions = EvalOptions {..}
    in Test {..}
 
+testWithStorage :: [(Term Natural, Term Natural)] -> Text -> Term Natural -> Term Natural -> Check () -> Test
+testWithStorage s = Test defaultEvalOptions (Storage (HashMap.fromList s))
+
 test :: Text -> Term Natural -> Term Natural -> Check () -> Test
-test = Test defaultEvalOptions
+test = testWithStorage []
 
 anomaCallingConventionTests :: [Test]
 anomaCallingConventionTests =
@@ -158,5 +166,6 @@ unitTests =
     test "push" [nock| [0 1] |] [nock| [push [[suc [@ L]] [@ S]]] |] (eqNock [nock| [1 0 1] |]),
     test "call" [nock| [quote 1] |] [nock| [call [S [@ S]]] |] (eqNock [nock| 1 |]),
     test "replace" [nock| [0 1] |] [nock| [replace [[L [quote 1]] [@ S]]] |] (eqNock [nock| [1 1] |]),
-    test "hint" [nock| [0 1] |] [nock| [hint [nil [trace [quote 2] [quote 3]]] [quote 1]] |] (eqTraces [[nock| 2 |]] >> eqNock [nock| 1 |])
+    test "hint" [nock| [0 1] |] [nock| [hint [nil [trace [quote 2] [quote 3]]] [quote 1]] |] (eqTraces [[nock| 2 |]] >> eqNock [nock| 1 |]),
+    testWithStorage [([nock| 111 |], [nock| 222 |])] "scry" [nock| nil |] [nock| [scry [quote nil] [quote 111]] |] (eqNock [nock| 222 |])
   ]