From 209e81a9918c0b3742005f75209126505116ead2 Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Fri, 20 Sep 2024 15:07:37 +0200
Subject: [PATCH] translate trace to puts hint

---
 src/Juvix/Compiler/Nockma/Evaluator.hs        | 12 +++++++++---
 src/Juvix/Compiler/Nockma/Language.hs         | 19 +++++++++++++++++++
 .../Compiler/Nockma/Translation/FromTree.hs   |  3 ++-
 3 files changed, 30 insertions(+), 4 deletions(-)

diff --git a/src/Juvix/Compiler/Nockma/Evaluator.hs b/src/Juvix/Compiler/Nockma/Evaluator.hs
index 3ca175c09a..adfacd7363 100644
--- a/src/Juvix/Compiler/Nockma/Evaluator.hs
+++ b/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
@@ -400,8 +400,14 @@ evalProfile inistack initerm =
               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)
diff --git a/src/Juvix/Compiler/Nockma/Language.hs b/src/Juvix/Compiler/Nockma/Language.hs
index 2fadde74b7..ae5f31964e 100644
--- a/src/Juvix/Compiler/Nockma/Language.hs
+++ b/src/Juvix/Compiler/Nockma/Language.hs
@@ -166,6 +166,8 @@ instance Pretty NockOp where
     OpScry -> "scry"
     OpTrace -> "trace"
 
+data NockHint = NockHintPuts
+
 textToStdlibFunctionMap :: HashMap Text StdlibFunction
 textToStdlibFunctionMap =
   hashMap
@@ -325,6 +327,23 @@ nockBoolLiteral b
   | b = nockTrueLiteral
   | otherwise = nockFalseLiteral
 
+nockHintValue :: NockHint -> Natural
+nockHintValue = \case
+  NockHintPuts -> 0x73747570
+
+nockHintAtom :: NockHint -> Term Natural
+nockHintAtom hint =
+  TermAtom
+    Atom
+      { _atomInfo =
+          AtomInfo
+            { _atomInfoLoc = Irrelevant Nothing,
+              _atomInfoTag = Nothing,
+              _atomInfoHint = Just AtomHintStdlibPlaceholder
+            },
+        _atom = nockHintValue hint
+      }
+
 instance NockNatural Natural where
   type ErrNockNatural Natural = NockNaturalNaturalError
   nockNatural a = return (a ^. atom)
diff --git a/src/Juvix/Compiler/Nockma/Translation/FromTree.hs b/src/Juvix/Compiler/Nockma/Translation/FromTree.hs
index 2a752e58b8..dff49a0fdc 100644
--- a/src/Juvix/Compiler/Nockma/Translation/FromTree.hs
+++ b/src/Juvix/Compiler/Nockma/Translation/FromTree.hs
@@ -656,7 +656,8 @@ compile = \case
       return $
         if
             -- TODO: remove duplication of `arg` here
-            | enabled -> OpTrace # arg # arg
+            | enabled ->
+                OpHint # (nockHintAtom NockHintPuts # arg) # arg
             | otherwise -> arg
 
     goBinop :: Tree.NodeBinop -> Sem r (Term Natural)