diff --git a/src/Juvix/Compiler/Nockma/Evaluator.hs b/src/Juvix/Compiler/Nockma/Evaluator.hs index 6593395fb9..59b515320d 100644 --- a/src/Juvix/Compiler/Nockma/Evaluator.hs +++ b/src/Juvix/Compiler/Nockma/Evaluator.hs @@ -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) diff --git a/src/Juvix/Compiler/Nockma/Language.hs b/src/Juvix/Compiler/Nockma/Language.hs index 2fadde74b7..0c550f1a26 100644 --- a/src/Juvix/Compiler/Nockma/Language.hs +++ b/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) diff --git a/src/Juvix/Compiler/Nockma/Translation/FromSource/Base.hs b/src/Juvix/Compiler/Nockma/Translation/FromSource/Base.hs index 4789007866..e1d8e44f10 100644 --- a/src/Juvix/Compiler/Nockma/Translation/FromSource/Base.hs +++ b/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 diff --git a/src/Juvix/Compiler/Nockma/Translation/FromTree.hs b/src/Juvix/Compiler/Nockma/Translation/FromTree.hs index f072554711..19fc49ede7 100644 --- a/src/Juvix/Compiler/Nockma/Translation/FromTree.hs +++ b/src/Juvix/Compiler/Nockma/Translation/FromTree.hs @@ -96,14 +96,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, @@ -731,7 +728,7 @@ compile = \case | enabled -> withTemp arg $ \ref -> do val <- addressTempRef ref - return $ OpTrace # val # val + return $ OpHint # (nockHintAtom NockHintPuts # val) # val | otherwise -> return arg goBinop :: Tree.NodeBinop -> Sem r (Term Natural) @@ -971,8 +968,7 @@ runCompilerWith opts constrs moduleFuns mainFun = compilerCtx = emptyCompilerCtx { _compilerFunctionInfos = functionInfos, - _compilerConstructorInfos = constrs, - _compilerOptions = opts + _compilerConstructorInfos = constrs } mainClosure :: Term Natural diff --git a/src/Juvix/Extra/Strings.hs b/src/Juvix/Extra/Strings.hs index f8626bc5f2..c310db1c59 100644 --- a/src/Juvix/Extra/Strings.hs +++ b/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" diff --git a/test/Anoma/Compilation/Positive.hs b/test/Anoma/Compilation/Positive.hs index 3f53eb01ba..dd8c37bb99 100644 --- a/test/Anoma/Compilation/Positive.hs +++ b/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 ".") diff --git a/test/Nockma/Eval/Positive.hs b/test/Nockma/Eval/Positive.hs index f8c47b19ed..32ca070ddf 100644 --- a/test/Nockma/Eval/Positive.hs +++ b/test/Nockma/Eval/Positive.hs @@ -138,7 +138,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 |]) ]