From 665fc9bb4eb57eee834bdb5368772f1b2d225902 Mon Sep 17 00:00:00 2001 From: Lukasz Czajka Date: Fri, 20 Sep 2024 15:07:37 +0200 Subject: [PATCH 1/6] 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) From 38758a4be7e69a44a73666e87a02c369d2184b73 Mon Sep 17 00:00:00 2001 From: Lukasz Czajka Date: Mon, 23 Sep 2024 15:46:00 +0200 Subject: [PATCH 2/6] remove the enable trace option --- .../Compiler/Nockma/Translation/FromTree.hs | 24 ++++++------------- 1 file changed, 7 insertions(+), 17 deletions(-) diff --git a/src/Juvix/Compiler/Nockma/Translation/FromTree.hs b/src/Juvix/Compiler/Nockma/Translation/FromTree.hs index dff49a0fdc..7acddf9113 100644 --- a/src/Juvix/Compiler/Nockma/Translation/FromTree.hs +++ b/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,13 +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 -> - OpHint # (nockHintAtom NockHintPuts # 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 @@ -923,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) @@ -935,8 +926,7 @@ runCompilerWith opts constrs moduleFuns mainFun = makeAnomaFun compilerCtx = CompilerCtx { _compilerFunctionInfos = functionInfos, - _compilerConstructorInfos = constrs, - _compilerOptions = opts + _compilerConstructorInfos = constrs } mainClosure :: Term Natural From 5b1eda795492a995edfd53ce89104096f5b4279f Mon Sep 17 00:00:00 2001 From: Lukasz Czajka Date: Mon, 23 Sep 2024 15:51:40 +0200 Subject: [PATCH 3/6] remove OpTrace --- src/Juvix/Compiler/Nockma/Evaluator.hs | 8 -------- src/Juvix/Compiler/Nockma/Language.hs | 3 --- 2 files changed, 11 deletions(-) diff --git a/src/Juvix/Compiler/Nockma/Evaluator.hs b/src/Juvix/Compiler/Nockma/Evaluator.hs index adfacd7363..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,13 +387,6 @@ 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)) diff --git a/src/Juvix/Compiler/Nockma/Language.hs b/src/Juvix/Compiler/Nockma/Language.hs index ae5f31964e..55ad1399bd 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,6 @@ instance Pretty NockOp where OpReplace -> "replace" OpHint -> "hint" OpScry -> "scry" - OpTrace -> "trace" data NockHint = NockHintPuts @@ -269,7 +267,6 @@ serializeOp = \case OpReplace -> 10 OpHint -> 11 OpScry -> 12 - OpTrace -> 100 class (NockmaEq a) => NockNatural a where type ErrNockNatural a :: Type From e4b320096181b7628a3a78ce986cc4e5bd0216a4 Mon Sep 17 00:00:00 2001 From: Lukasz Czajka Date: Mon, 23 Sep 2024 17:14:44 +0200 Subject: [PATCH 4/6] update tests --- test/Nockma/Eval/Positive.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/test/Nockma/Eval/Positive.hs b/test/Nockma/Eval/Positive.hs index f304020955..106905b5c5 100644 --- a/test/Nockma/Eval/Positive.hs +++ b/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 |]) ] From 568b2966e731169342d8175afe8c37f0b0541dc9 Mon Sep 17 00:00:00 2001 From: Lukasz Czajka Date: Mon, 23 Sep 2024 18:18:42 +0200 Subject: [PATCH 5/6] %puts parsing --- src/Juvix/Compiler/Nockma/Language.hs | 12 ++++++------ .../Compiler/Nockma/Translation/FromSource/Base.hs | 8 ++++++++ src/Juvix/Extra/Strings.hs | 3 +++ 3 files changed, 17 insertions(+), 6 deletions(-) diff --git a/src/Juvix/Compiler/Nockma/Language.hs b/src/Juvix/Compiler/Nockma/Language.hs index 55ad1399bd..0c550f1a26 100644 --- a/src/Juvix/Compiler/Nockma/Language.hs +++ b/src/Juvix/Compiler/Nockma/Language.hs @@ -165,6 +165,7 @@ instance Pretty NockOp where OpScry -> "scry" data NockHint = NockHintPuts + deriving stock (Show, Eq, Enum, Bounded) textToStdlibFunctionMap :: HashMap Text StdlibFunction textToStdlibFunctionMap = @@ -324,6 +325,10 @@ nockBoolLiteral b | b = nockTrueLiteral | otherwise = nockFalseLiteral +nockHintName :: NockHint -> Text +nockHintName = \case + NockHintPuts -> "puts" + nockHintValue :: NockHint -> Natural nockHintValue = \case NockHintPuts -> 0x73747570 @@ -332,12 +337,7 @@ nockHintAtom :: NockHint -> Term Natural nockHintAtom hint = TermAtom Atom - { _atomInfo = - AtomInfo - { _atomInfoLoc = Irrelevant Nothing, - _atomInfoTag = Nothing, - _atomInfoHint = Just AtomHintStdlibPlaceholder - }, + { _atomInfo = emptyAtomInfo, _atom = nockHintValue hint } 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/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" From 7829e9a932c05e6d7e3e15e2ffb64b121edb0486 Mon Sep 17 00:00:00 2001 From: Lukasz Czajka Date: Mon, 23 Sep 2024 18:32:09 +0200 Subject: [PATCH 6/6] fix anoma tests --- test/Anoma/Compilation/Positive.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) 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 ".")