translate trace to puts hint

anoma · Sep 23, 2024 · 209e81a · 209e81a
1 parent 49e8c9d
commit 209e81a
Show file tree

Hide file tree

Showing 3 changed files with 30 additions and 4 deletions.
diff --git 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
@@ -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
@@ -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)