Nockma backend: translate trace to %puts hints (#3053)

* Closes #3022 
* Requires https://github.com/anoma/anoma/pull/861

src/Juvix/Compiler/Nockma/Evaluator.hs

@@ -16,8 +16,8 @@ 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.Compiler.Nockma.Pretty
 import Juvix.Prelude hiding (Atom, Path)
-import Juvix.Prelude.Pretty
 
 newtype OpCounts = OpCounts
   { _opCountsMap :: HashMap NockOp Int
@@ -358,7 +358,6 @@ evalProfile inistack initerm =
             OpReplace -> goOpReplace
             OpHint -> goOpHint
             OpScry -> goOpScry
-            OpTrace -> goOpTrace
           where
             crumb crumbTag =
               EvalCrumbOperator $
@@ -388,20 +387,19 @@ evalProfile inistack initerm =
                 TermCell {} -> nockTrue
                 TermAtom {} -> nockFalse
 
-            goOpTrace :: Sem r (Term a)
-            goOpTrace = do
-              Cell' tr a _ <- withCrumb (crumb crumbDecodeFirst) (asCell (c ^. operatorCellTerm))
-              tr' <- evalArg crumbEvalFirst stack tr
-              output tr'
-              evalArg crumbEvalSecond stack a
-
             goOpHint :: Sem r (Term a)
             goOpHint = do
               Cell' l r _ <- withCrumb (crumb crumbDecodeFirst) (asCell (c ^. operatorCellTerm))
               case l of
                 TAtom {} -> evalArg crumbEvalFirst stack r
-                TCell _t1 t2 -> do
-                  void (evalArg crumbEvalFirst stack t2)
+                TCell t1 t2 -> do
+                  t2' <- evalArg crumbEvalFirst stack t2
+                  putsHint <- fromNatural (nockHintValue NockHintPuts)
+                  case t1 of
+                    TAtom a
+                      | a == putsHint ->
+                          output t2'
+                    _ -> return ()
                   evalArg crumbEvalSecond stack r
 
             goOpPush :: Sem r (Term a)

src/Juvix/Compiler/Nockma/Language.hs

@@ -144,7 +144,6 @@ data NockOp
   | OpReplace
   | OpHint
   | OpScry
-  | OpTrace
   deriving stock (Bounded, Enum, Eq, Generic)
 
 instance Hashable NockOp
@@ -164,7 +163,9 @@ instance Pretty NockOp where
     OpReplace -> "replace"
     OpHint -> "hint"
     OpScry -> "scry"
-    OpTrace -> "trace"
+
+data NockHint = NockHintPuts
+  deriving stock (Show, Eq, Enum, Bounded)
 
 textToStdlibFunctionMap :: HashMap Text StdlibFunction
 textToStdlibFunctionMap =
@@ -267,7 +268,6 @@ serializeOp = \case
   OpReplace -> 10
   OpHint -> 11
   OpScry -> 12
-  OpTrace -> 100
 
 class (NockmaEq a) => NockNatural a where
   type ErrNockNatural a :: Type
@@ -325,6 +325,22 @@ nockBoolLiteral b
   | b = nockTrueLiteral
   | otherwise = nockFalseLiteral
 
+nockHintName :: NockHint -> Text
+nockHintName = \case
+  NockHintPuts -> "puts"
+
+nockHintValue :: NockHint -> Natural
+nockHintValue = \case
+  NockHintPuts -> 0x73747570
+
+nockHintAtom :: NockHint -> Term Natural
+nockHintAtom hint =
+  TermAtom
+    Atom
+      { _atomInfo = emptyAtomInfo,
+        _atom = nockHintValue hint
+      }
+
 instance NockNatural Natural where
   type ErrNockNatural Natural = NockNaturalNaturalError
   nockNatural a = return (a ^. atom)

src/Juvix/Compiler/Nockma/Translation/FromSource/Base.hs

@@ -151,10 +151,18 @@ atomStringLiteral = do
           }
   return (Atom (textToNatural s) info)
 
+atomNockHint :: Maybe Tag -> Parser (Atom Natural)
+atomNockHint mtag = do
+  symbol Str.percent
+  let hints :: [NockHint] = enumerate
+  val <- choice (map (\hnt -> symbol (nockHintName hnt) >> return (nockHintValue hnt)) hints)
+  return (Atom val emptyAtomInfo {_atomInfoTag = mtag})
+
 patom :: Parser (Atom Natural)
 patom = do
   mtag <- optional pTag
   atomOp mtag
+    <|> atomNockHint mtag
     <|> atomNat mtag
     <|> atomPath mtag
     <|> atomBool

src/Juvix/Compiler/Nockma/Translation/FromTree.hs

@@ -94,14 +94,11 @@ data BuiltinFunctionId
 
 instance Hashable BuiltinFunctionId
 
-newtype CompilerOptions = CompilerOptions
-  {_compilerOptionsEnableTrace :: Bool}
+data CompilerOptions = CompilerOptions
 
 fromEntryPoint :: EntryPoint -> CompilerOptions
-fromEntryPoint EntryPoint {..} =
+fromEntryPoint EntryPoint {} =
   CompilerOptions
-    { _compilerOptionsEnableTrace = _entryPointDebug
-    }
 
 data FunctionInfo = FunctionInfo
   { _functionInfoPath :: Path,
@@ -115,8 +112,7 @@ newtype FunctionCtx = FunctionCtx
 
 data CompilerCtx = CompilerCtx
   { _compilerFunctionInfos :: HashMap FunctionId FunctionInfo,
-    _compilerConstructorInfos :: ConstructorInfos,
-    _compilerOptions :: CompilerOptions
+    _compilerConstructorInfos :: ConstructorInfos
   }
 
 data ConstructorInfo = ConstructorInfo
@@ -652,12 +648,8 @@ compile = \case
 
     goTrace :: Term Natural -> Sem r (Term Natural)
     goTrace arg = do
-      enabled <- asks (^. compilerOptions . compilerOptionsEnableTrace)
-      return $
-        if
-            -- TODO: remove duplication of `arg` here
-            | enabled -> OpTrace # arg # arg
-            | otherwise -> arg
+      -- TODO: remove duplication of `arg` here
+      return $ OpHint # (nockHintAtom NockHintPuts # arg) # arg
 
     goBinop :: Tree.NodeBinop -> Sem r (Term Natural)
     goBinop Tree.NodeBinop {..} = do
@@ -922,7 +914,7 @@ remakeList :: (Foldable l) => l (Term Natural) -> Term Natural
 remakeList ts = foldTerms (toList ts `prependList` pure (OpQuote # nockNilTagged "remakeList"))
 
 runCompilerWith :: CompilerOptions -> ConstructorInfos -> [CompilerFunction] -> CompilerFunction -> AnomaResult
-runCompilerWith opts constrs moduleFuns mainFun = makeAnomaFun
+runCompilerWith _opts constrs moduleFuns mainFun = makeAnomaFun
   where
     libFuns :: [CompilerFunction]
     libFuns = moduleFuns ++ (builtinFunction <$> allElements)
@@ -934,8 +926,7 @@ runCompilerWith opts constrs moduleFuns mainFun = makeAnomaFun
     compilerCtx =
       CompilerCtx
         { _compilerFunctionInfos = functionInfos,
-          _compilerConstructorInfos = constrs,
-          _compilerOptions = opts
+          _compilerConstructorInfos = constrs
         }
 
     mainClosure :: Term Natural

src/Juvix/Extra/Strings.hs

@@ -803,6 +803,9 @@ tagTag = "tag@"
 stdlibTag :: (IsString s) => s
 stdlibTag = "stdlib@"
 
+percent :: (IsString s) => s
+percent = "%"
+
 instrSub :: (IsString s) => s
 instrSub = "sub"
 

test/Anoma/Compilation/Positive.hs

@@ -40,8 +40,8 @@ mkAnomaCallTest' enableDebug _testProgramStorage _testName relRoot mainFile args
           <$> testDefaultEntryPointIO testRootDir (testRootDir <//> mainFile)
       (^. pipelineResult) . snd <$> testRunIO entryPoint upToAnoma
 
-mkAnomaCallTestNoTrace :: Text -> Prelude.Path Rel Dir -> Prelude.Path Rel File -> [Term Natural] -> Check () -> TestTree
-mkAnomaCallTestNoTrace = mkAnomaCallTest' False emptyStorage
+mkAnomaCallTestNoDebug :: Text -> Prelude.Path Rel Dir -> Prelude.Path Rel File -> [Term Natural] -> Check () -> TestTree
+mkAnomaCallTestNoDebug = mkAnomaCallTest' False emptyStorage
 
 mkAnomaCallTest :: Text -> Prelude.Path Rel Dir -> Prelude.Path Rel File -> [Term Natural] -> Check () -> TestTree
 mkAnomaCallTest = mkAnomaCallTest' True emptyStorage
@@ -78,12 +78,12 @@ allTests =
         $(mkRelFile "test003.juvix")
         []
         (checkNatOutput [1, 4, 2, 4, 0]),
-      mkAnomaCallTestNoTrace
-        "Test003: Integer arithmetic - no trace"
+      mkAnomaCallTestNoDebug
+        "Test003: Integer arithmetic - no debug"
         $(mkRelDir ".")
         $(mkRelFile "test003.juvix")
         []
-        (checkNatOutput [0]),
+        (checkNatOutput [1, 4, 2, 4, 0]),
       mkAnomaCallTest
         "Test005: Higher-order functions"
         $(mkRelDir ".")

test/Nockma/Eval/Positive.hs

@@ -132,7 +132,7 @@ anomaTest n mainFun args _testCheck _evalInterceptStdlibCalls =
         | _evalInterceptStdlibCalls = n <> " - intercept stdlib"
         | otherwise = n
 
-      opts = CompilerOptions {_compilerOptionsEnableTrace = False}
+      opts = CompilerOptions
 
       res :: AnomaResult = runCompilerWith opts mempty [] f
       _testProgramSubject = res ^. anomaClosure
@@ -302,7 +302,7 @@ 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 [1937012080 [quote 2]] [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 |]),
     withAssertErrKeyNotInStorage $ testWithStorage [([nock| 333 |], [nock| 222 |]), ([nock| 3 |], [nock| 222 |])] "scry" [nock| nil |] [nock| [scry [quote nil] [quote 111]] |] (eqNock [nock| 222 |])
   ]