From 9b17f9c492d5fbd2bd26ef7537be1fbd0933229a Mon Sep 17 00:00:00 2001 From: Paul Cadman Date: Wed, 15 May 2024 19:43:23 +0100 Subject: [PATCH] refactor: Add Anoma Node in Tree language Similarly to how the Cairo operations are handled we add a separate Tree language Node for Anoma operations instead of handling then as an Unop Node. --- .../Compiler/Asm/Translation/FromTree.hs | 4 +--- src/Juvix/Compiler/Core/Language/Builtins.hs | 3 +++ .../Compiler/Nockma/Translation/FromTree.hs | 24 ++++++++++++------- src/Juvix/Compiler/Tree/Evaluator.hs | 4 +--- src/Juvix/Compiler/Tree/EvaluatorEff.hs | 4 +--- src/Juvix/Compiler/Tree/Extra/Base.hs | 12 ++++++++++ src/Juvix/Compiler/Tree/Keywords.hs | 4 ++++ src/Juvix/Compiler/Tree/Language.hs | 13 +++++----- src/Juvix/Compiler/Tree/Language/Builtins.hs | 10 ++++++++ src/Juvix/Compiler/Tree/Pretty/Base.hs | 16 ++++++++++--- .../Tree/Transformation/CheckNoAnoma.hs | 7 ++---- .../Compiler/Tree/Transformation/Validate.hs | 9 ++++--- .../Compiler/Tree/Translation/FromCore.hs | 17 ++++++++++--- .../Compiler/Tree/Translation/FromSource.hs | 20 +++++++++++++++- src/Juvix/Data/Keyword/All.hs | 6 +++++ test/Tree/Transformation/CheckNoAnoma.hs | 10 +++++++- tests/Tree/negative/test010.jvt | 5 ++++ tests/Tree/negative/test011.jvt | 5 ++++ 18 files changed, 133 insertions(+), 40 deletions(-) create mode 100644 tests/Tree/negative/test010.jvt create mode 100644 tests/Tree/negative/test011.jvt diff --git a/src/Juvix/Compiler/Asm/Translation/FromTree.hs b/src/Juvix/Compiler/Asm/Translation/FromTree.hs index f0c78e2cf5..6974d23d8e 100644 --- a/src/Juvix/Compiler/Asm/Translation/FromTree.hs +++ b/src/Juvix/Compiler/Asm/Translation/FromTree.hs @@ -39,6 +39,7 @@ genCode fi = Tree.Binop x -> goBinop isTail x Tree.Unop x -> goUnop isTail x Tree.Cairo x -> goCairo isTail x + Tree.Anoma {} -> error "Anoma instructions are not supported in the Asm backend" Tree.Constant x -> goConstant isTail x Tree.MemRef x -> goMemRef isTail x Tree.AllocConstr x -> goAllocConstr isTail x @@ -233,9 +234,6 @@ genCode fi = Tree.PrimUnop op' -> mkUnop op' Tree.OpTrace -> mkInstr Trace Tree.OpFail -> mkInstr Failure - Tree.OpAnomaGet -> impossible - Tree.OpAnomaEncode -> impossible - Tree.OpAnomaDecode -> impossible snocReturn :: Bool -> Code' -> Code' snocReturn True code = DL.snoc code (mkInstr Return) diff --git a/src/Juvix/Compiler/Core/Language/Builtins.hs b/src/Juvix/Compiler/Core/Language/Builtins.hs index aaea5a6165..ace9dde327 100644 --- a/src/Juvix/Compiler/Core/Language/Builtins.hs +++ b/src/Juvix/Compiler/Core/Language/Builtins.hs @@ -121,6 +121,9 @@ builtinIsFoldable = \case builtinIsCairo :: BuiltinOp -> Bool builtinIsCairo op = op `elem` builtinsCairo +builtinIsAnoma :: BuiltinOp -> Bool +builtinIsAnoma op = op `elem` builtinsAnoma + builtinsString :: [BuiltinOp] builtinsString = [OpStrConcat, OpStrToInt, OpShow] diff --git a/src/Juvix/Compiler/Nockma/Translation/FromTree.hs b/src/Juvix/Compiler/Nockma/Translation/FromTree.hs index fa7b43bade..370ef59396 100644 --- a/src/Juvix/Compiler/Nockma/Translation/FromTree.hs +++ b/src/Juvix/Compiler/Nockma/Translation/FromTree.hs @@ -330,6 +330,7 @@ compile = \case Tree.Binop b -> goBinop b Tree.Unop b -> goUnop b Tree.Cairo {} -> cairoErr + Tree.Anoma b -> goAnomaOp b Tree.Constant c -> return (goConstant (c ^. Tree.nodeConstant)) Tree.MemRef c -> goMemRef (c ^. Tree.nodeMemRef) Tree.AllocConstr c -> goAllocConstr c @@ -418,6 +419,14 @@ compile = \case iffalse <- compile _nodeBranchFalse return (branch arg iftrue iffalse) + goAnomaOp :: Tree.NodeAnoma -> Sem r (Term Natural) + goAnomaOp Tree.NodeAnoma {..} = do + args <- mapM compile _nodeAnomaArgs + case _nodeAnomaOpcode of + Tree.OpAnomaGet -> goAnomaGet args + Tree.OpAnomaEncode -> goAnomaEncode args + Tree.OpAnomaDecode -> goAnomaDecode args + goUnop :: Tree.NodeUnop -> Sem r (Term Natural) goUnop Tree.NodeUnop {..} = do arg <- compile _nodeUnopArg @@ -425,9 +434,6 @@ compile = \case Tree.PrimUnop op -> return $ goPrimUnop op arg Tree.OpFail -> return crash Tree.OpTrace -> goTrace arg - Tree.OpAnomaGet -> goAnomaGet arg - Tree.OpAnomaEncode -> goAnomaEncode arg - Tree.OpAnomaDecode -> goAnomaDecode arg goPrimUnop :: Tree.UnaryOp -> Term Natural -> Term Natural goPrimUnop op arg = case op of @@ -439,16 +445,16 @@ compile = \case Tree.OpIntToField -> fieldErr Tree.OpFieldToInt -> fieldErr - goAnomaGet :: Term Natural -> Sem r (Term Natural) + goAnomaGet :: [Term Natural] -> Sem r (Term Natural) goAnomaGet key = do - let arg = remakeList [getFieldInSubject AnomaGetOrder, key] + let arg = remakeList [getFieldInSubject AnomaGetOrder, foldTermsOrNil key] return (OpScry # (OpQuote # nockNilTagged "OpScry-typehint") # arg) - goAnomaEncode :: Term Natural -> Sem r (Term Natural) - goAnomaEncode arg = return (callStdlib StdlibEncode [arg]) + goAnomaEncode :: [Term Natural] -> Sem r (Term Natural) + goAnomaEncode args = return (callStdlib StdlibEncode args) - goAnomaDecode :: Term Natural -> Sem r (Term Natural) - goAnomaDecode arg = return (callStdlib StdlibDecode [arg]) + goAnomaDecode :: [Term Natural] -> Sem r (Term Natural) + goAnomaDecode args = return (callStdlib StdlibDecode args) goTrace :: Term Natural -> Sem r (Term Natural) goTrace arg = do diff --git a/src/Juvix/Compiler/Tree/Evaluator.hs b/src/Juvix/Compiler/Tree/Evaluator.hs index 15a9505b56..e598d192e5 100644 --- a/src/Juvix/Compiler/Tree/Evaluator.hs +++ b/src/Juvix/Compiler/Tree/Evaluator.hs @@ -37,6 +37,7 @@ hEval hout tab = eval' [] mempty eval' args temps node = case node of Binop x -> goBinop x Unop x -> goUnop x + Anoma {} -> evalError "unsupported: Anoma builtin" Cairo {} -> evalError "unsupported: Cairo builtin" Constant c -> goConstant c MemRef x -> goMemRef x @@ -74,9 +75,6 @@ hEval hout tab = eval' [] mempty PrimUnop op -> eitherToError $ evalUnop tab op v OpTrace -> goTrace v OpFail -> goFail v - OpAnomaGet -> evalError "Unsupported op: OpAnomaGet" - OpAnomaEncode -> evalError "Unsupported op: OpAnomaEncode" - OpAnomaDecode -> evalError "Unsupported op: OpAnomaDecode" goFail :: Value -> Value goFail v = evalError ("failure: " <> printValue tab v) diff --git a/src/Juvix/Compiler/Tree/EvaluatorEff.hs b/src/Juvix/Compiler/Tree/EvaluatorEff.hs index b93e33b8d8..2acca9d3e4 100644 --- a/src/Juvix/Compiler/Tree/EvaluatorEff.hs +++ b/src/Juvix/Compiler/Tree/EvaluatorEff.hs @@ -33,6 +33,7 @@ eval tab = runReader emptyEvalCtx . eval' eval' node = case node of Binop x -> goBinop x Unop x -> goUnop x + Anoma {} -> evalError "unsupported: Anoma builtins" Cairo {} -> evalError "unsupported: Cairo builtins" Constant c -> return (goConstant c) MemRef x -> goMemRef x @@ -69,9 +70,6 @@ eval tab = runReader emptyEvalCtx . eval' PrimUnop op -> eitherToError $ evalUnop tab op v OpTrace -> goTrace v OpFail -> goFail v - OpAnomaGet -> evalError "Unsupported op: OpAnomaGet" - OpAnomaEncode -> evalError "Unsupported op: OpAnomaEncode" - OpAnomaDecode -> evalError "Unsupported op: OpAnomaDecode" goFail :: Value -> Sem r' Value goFail v = evalError ("failure: " <> printValue tab v) diff --git a/src/Juvix/Compiler/Tree/Extra/Base.hs b/src/Juvix/Compiler/Tree/Extra/Base.hs index 348e5b791e..38b676670f 100644 --- a/src/Juvix/Compiler/Tree/Extra/Base.hs +++ b/src/Juvix/Compiler/Tree/Extra/Base.hs @@ -19,6 +19,7 @@ getNodeInfo = \case Binop NodeBinop {..} -> _nodeBinopInfo Unop NodeUnop {..} -> _nodeUnopInfo Cairo NodeCairo {..} -> _nodeCairoInfo + Anoma NodeAnoma {..} -> _nodeAnomaInfo Constant NodeConstant {..} -> _nodeConstantInfo MemRef NodeMemRef {..} -> _nodeMemRefInfo AllocConstr NodeAllocConstr {..} -> _nodeAllocConstrInfo @@ -152,6 +153,17 @@ destruct = \case _nodeCairoInfo } } + Anoma NodeAnoma {..} -> + NodeDetails + { _nodeChildren = map noTempVar _nodeAnomaArgs, + _nodeReassemble = manyChildren $ \args -> + Anoma + NodeAnoma + { _nodeAnomaArgs = args, + _nodeAnomaOpcode, + _nodeAnomaInfo + } + } Constant c -> NodeDetails { _nodeChildren = [], diff --git a/src/Juvix/Compiler/Tree/Keywords.hs b/src/Juvix/Compiler/Tree/Keywords.hs index 991160b7b5..1c17f29ec3 100644 --- a/src/Juvix/Compiler/Tree/Keywords.hs +++ b/src/Juvix/Compiler/Tree/Keywords.hs @@ -9,6 +9,8 @@ import Juvix.Compiler.Tree.Keywords.Base import Juvix.Data.Keyword.All ( kwAdd_, kwAlloc, + kwAnomaDecode, + kwAnomaEncode, kwAnomaGet, kwArgsNum, kwAtoi, @@ -74,6 +76,8 @@ allKeywords = kwCase, kwSave, kwAnomaGet, + kwAnomaDecode, + kwAnomaEncode, kwPoseidon, kwEcOp, kwRandomEcPoint diff --git a/src/Juvix/Compiler/Tree/Language.hs b/src/Juvix/Compiler/Tree/Language.hs index e843ce2d87..d4242f74f2 100644 --- a/src/Juvix/Compiler/Tree/Language.hs +++ b/src/Juvix/Compiler/Tree/Language.hs @@ -17,6 +17,7 @@ data Node = Binop NodeBinop | Unop NodeUnop | Cairo NodeCairo + | Anoma NodeAnoma | -- | A constant value. Constant NodeConstant | -- | A memory reference. @@ -67,12 +68,6 @@ data UnaryOpcode OpTrace | -- | Interrupt execution with a runtime error printing the argument. OpFail - | -- | Get a value by key from Anoma storage - OpAnomaGet - | -- | Encode a value to an Anoma atom - OpAnomaEncode - | -- | Decode a value from an Anoma atom - OpAnomaDecode data NodeBinop = NodeBinop { _nodeBinopInfo :: NodeInfo, @@ -93,6 +88,12 @@ data NodeCairo = NodeCairo _nodeCairoArgs :: [Node] } +data NodeAnoma = NodeAnoma + { _nodeAnomaInfo :: NodeInfo, + _nodeAnomaOpcode :: AnomaOp, + _nodeAnomaArgs :: [Node] + } + data NodeConstant = NodeConstant { _nodeConstantInfo :: NodeInfo, _nodeConstant :: Constant diff --git a/src/Juvix/Compiler/Tree/Language/Builtins.hs b/src/Juvix/Compiler/Tree/Language/Builtins.hs index 60c27b69e3..e333ada20b 100644 --- a/src/Juvix/Compiler/Tree/Language/Builtins.hs +++ b/src/Juvix/Compiler/Tree/Language/Builtins.hs @@ -47,3 +47,13 @@ cairoOpArgsNum = \case OpCairoPoseidon -> 1 OpCairoEc -> 3 OpCairoRandomEcPoint -> 0 + +-- | Builtin Anoma operations. Implemented only in the Anoma backend. +data AnomaOp + = -- | Get a value by key from Anoma storage + OpAnomaGet + | -- | Encode a value to an Anoma atom + OpAnomaEncode + | -- | Decode a value from an Anoma atom + OpAnomaDecode + deriving stock (Eq) diff --git a/src/Juvix/Compiler/Tree/Pretty/Base.hs b/src/Juvix/Compiler/Tree/Pretty/Base.hs index c1e0d58e87..6b45efb9eb 100644 --- a/src/Juvix/Compiler/Tree/Pretty/Base.hs +++ b/src/Juvix/Compiler/Tree/Pretty/Base.hs @@ -240,14 +240,17 @@ instance PrettyCode CairoOp where OpCairoEc -> Str.instrEcOp OpCairoRandomEcPoint -> Str.cairoRandomEcPoint +instance PrettyCode AnomaOp where + ppCode op = return . primitive $ case op of + OpAnomaGet -> Str.anomaGet + OpAnomaEncode -> Str.anomaEncode + OpAnomaDecode -> Str.anomaDecode + instance PrettyCode UnaryOpcode where ppCode = \case PrimUnop x -> ppCode x OpTrace -> return $ primitive Str.instrTrace OpFail -> return $ primitive Str.instrFailure - OpAnomaGet -> return $ primitive Str.anomaGet - OpAnomaEncode -> return $ primitive Str.anomaEncode - OpAnomaDecode -> return $ primitive Str.anomaDecode instance PrettyCode NodeUnop where ppCode NodeUnop {..} = do @@ -261,6 +264,12 @@ instance PrettyCode NodeCairo where args <- ppCodeArgs _nodeCairoArgs return $ op <> parens args +instance PrettyCode NodeAnoma where + ppCode NodeAnoma {..} = do + op <- ppCode _nodeAnomaOpcode + args <- ppCodeArgs _nodeAnomaArgs + return (op <> parens args) + instance PrettyCode NodeConstant where ppCode NodeConstant {..} = ppCode _nodeConstant @@ -353,6 +362,7 @@ instance PrettyCode Node where ppCode = \case Binop x -> ppCode x Unop x -> ppCode x + Anoma x -> ppCode x Cairo x -> ppCode x Constant x -> ppCode x MemRef x -> ppCode x diff --git a/src/Juvix/Compiler/Tree/Transformation/CheckNoAnoma.hs b/src/Juvix/Compiler/Tree/Transformation/CheckNoAnoma.hs index 95349e8122..f7b098099f 100644 --- a/src/Juvix/Compiler/Tree/Transformation/CheckNoAnoma.hs +++ b/src/Juvix/Compiler/Tree/Transformation/CheckNoAnoma.hs @@ -10,19 +10,16 @@ checkNoAnoma = walkT checkNode where checkNode :: Symbol -> Node -> Sem r () checkNode _ = \case - Unop NodeUnop {..} -> case _nodeUnopOpcode of + Anoma NodeAnoma {..} -> case _nodeAnomaOpcode of OpAnomaGet -> unsupportedErr "OpAnomaGet" OpAnomaEncode -> unsupportedErr "OpAnomaEncode" OpAnomaDecode -> unsupportedErr "OpAnomaDecode" - OpFail -> return () - OpTrace -> return () - PrimUnop {} -> return () where unsupportedErr :: Text -> Sem r () unsupportedErr opName = throw TreeError { _treeErrorMsg = opName <> " is unsupported", - _treeErrorLoc = _nodeUnopInfo ^. nodeInfoLocation + _treeErrorLoc = _nodeAnomaInfo ^. nodeInfoLocation } _ -> return () diff --git a/src/Juvix/Compiler/Tree/Transformation/Validate.hs b/src/Juvix/Compiler/Tree/Transformation/Validate.hs index 455d21d913..8c6c794299 100644 --- a/src/Juvix/Compiler/Tree/Transformation/Validate.hs +++ b/src/Juvix/Compiler/Tree/Transformation/Validate.hs @@ -16,6 +16,7 @@ inferType tab funInfo = goInfer mempty Binop x -> goBinop bl x Unop x -> goUnop bl x Cairo x -> goCairo bl x + Anoma x -> goAnoma bl x Constant x -> goConst bl x MemRef x -> goMemRef bl x AllocConstr x -> goAllocConstr bl x @@ -65,9 +66,6 @@ inferType tab funInfo = goInfer mempty PrimUnop x -> checkPrimUnop x OpTrace -> goInfer bl _nodeUnopArg OpFail -> checkUnop TyDynamic TyDynamic - OpAnomaGet -> checkUnop TyDynamic TyDynamic - OpAnomaEncode -> checkUnop TyDynamic TyDynamic - OpAnomaDecode -> checkUnop TyDynamic TyDynamic where loc = _nodeUnopInfo ^. nodeInfoLocation @@ -90,6 +88,11 @@ inferType tab funInfo = goInfer mempty mapM_ (\arg -> checkType bl arg TyDynamic) _nodeCairoArgs return TyDynamic + goAnoma :: BinderList Type -> NodeAnoma -> Sem r Type + goAnoma bl NodeAnoma {..} = do + mapM_ (\arg -> checkType bl arg TyDynamic) _nodeAnomaArgs + return TyDynamic + goConst :: BinderList Type -> NodeConstant -> Sem r Type goConst _ NodeConstant {..} = case _nodeConstant of ConstInt {} -> return mkTypeInteger diff --git a/src/Juvix/Compiler/Tree/Translation/FromCore.hs b/src/Juvix/Compiler/Tree/Translation/FromCore.hs index 51e49da340..b75b8f99f0 100644 --- a/src/Juvix/Compiler/Tree/Translation/FromCore.hs +++ b/src/Juvix/Compiler/Tree/Translation/FromCore.hs @@ -145,6 +145,13 @@ genCode infoTable fi = _nodeCairoOpcode = genCairoOp _builtinAppOp, _nodeCairoArgs = args } + | Core.builtinIsAnoma _builtinAppOp = + Anoma $ + NodeAnoma + { _nodeAnomaInfo = mempty, + _nodeAnomaOpcode = genAnomaOp _builtinAppOp, + _nodeAnomaArgs = args + } | otherwise = case args of [arg] -> @@ -295,9 +302,6 @@ genCode infoTable fi = Core.OpFieldToInt -> PrimUnop OpFieldToInt Core.OpTrace -> OpTrace Core.OpFail -> OpFail - Core.OpAnomaGet -> OpAnomaGet - Core.OpAnomaEncode -> OpAnomaEncode - Core.OpAnomaDecode -> OpAnomaDecode _ -> impossible genCairoOp :: Core.BuiltinOp -> CairoOp @@ -307,6 +311,13 @@ genCode infoTable fi = Core.OpRandomEcPoint -> OpCairoRandomEcPoint _ -> impossible + genAnomaOp :: Core.BuiltinOp -> AnomaOp + genAnomaOp = \case + Core.OpAnomaGet -> OpAnomaGet + Core.OpAnomaEncode -> OpAnomaEncode + Core.OpAnomaDecode -> OpAnomaDecode + _ -> impossible + getArgsNum :: Symbol -> Int getArgsNum sym = fromMaybe diff --git a/src/Juvix/Compiler/Tree/Translation/FromSource.hs b/src/Juvix/Compiler/Tree/Translation/FromSource.hs index 14291fc18f..12fd4ad16f 100644 --- a/src/Juvix/Compiler/Tree/Translation/FromSource.hs +++ b/src/Juvix/Compiler/Tree/Translation/FromSource.hs @@ -53,6 +53,7 @@ parseNode :: parseNode = (Binop <$> parseBinop) <|> (Unop <$> parseUnop) + <|> (Anoma <$> parseAnoma) <|> (Cairo <$> parseCairo) <|> (Constant <$> parseConst) <|> (AllocConstr <$> parseAlloc) @@ -107,7 +108,6 @@ parseUnop = <|> parseUnaryOp kwTrace OpTrace <|> parseUnaryOp kwFail OpFail <|> parseUnaryOp kwArgsNum (PrimUnop OpArgsNum) - <|> parseUnaryOp kwAnomaGet (OpAnomaGet) parseUnaryOp :: (Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) => @@ -119,6 +119,24 @@ parseUnaryOp kwd op = do arg <- parens parseNode return $ NodeUnop (NodeInfo (Just loc)) op arg +parseAnoma :: + (Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) => + ParsecS r NodeAnoma +parseAnoma = + parseAnoma' kwAnomaGet OpAnomaGet + <|> parseAnoma' kwAnomaDecode OpAnomaDecode + <|> parseAnoma' kwAnomaEncode OpAnomaEncode + +parseAnoma' :: + (Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) => + Keyword -> + AnomaOp -> + ParsecS r NodeAnoma +parseAnoma' kwd op = do + loc <- onlyInterval (kw kwd) + args <- parseArgs + return $ NodeAnoma (NodeInfo (Just loc)) op args + parseCairo :: (Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) => ParsecS r NodeCairo diff --git a/src/Juvix/Data/Keyword/All.hs b/src/Juvix/Data/Keyword/All.hs index 1ead24a154..60d4da5911 100644 --- a/src/Juvix/Data/Keyword/All.hs +++ b/src/Juvix/Data/Keyword/All.hs @@ -445,6 +445,12 @@ kwLive = asciiKw Str.live kwAnomaGet :: Keyword kwAnomaGet = asciiKw Str.anomaGet +kwAnomaDecode :: Keyword +kwAnomaDecode = asciiKw Str.anomaDecode + +kwAnomaEncode :: Keyword +kwAnomaEncode = asciiKw Str.anomaEncode + delimBraceL :: Keyword delimBraceL = mkDelim Str.braceL diff --git a/test/Tree/Transformation/CheckNoAnoma.hs b/test/Tree/Transformation/CheckNoAnoma.hs index 2444991c51..0a49eb57fb 100644 --- a/test/Tree/Transformation/CheckNoAnoma.hs +++ b/test/Tree/Transformation/CheckNoAnoma.hs @@ -63,5 +63,13 @@ tests = [ Eval.NegTest "anomaGet" $(mkRelDir ".") - $(mkRelFile "test009.jvt") + $(mkRelFile "test009.jvt"), + Eval.NegTest + "anomaDecode" + $(mkRelDir ".") + $(mkRelFile "test010.jvt"), + Eval.NegTest + "anomaEncode" + $(mkRelDir ".") + $(mkRelFile "test011.jvt") ] diff --git a/tests/Tree/negative/test010.jvt b/tests/Tree/negative/test010.jvt new file mode 100644 index 0000000000..99002462bd --- /dev/null +++ b/tests/Tree/negative/test010.jvt @@ -0,0 +1,5 @@ +-- calling unsupported anoma-decode + +function main() : * { + anoma-decode(1) +} diff --git a/tests/Tree/negative/test011.jvt b/tests/Tree/negative/test011.jvt new file mode 100644 index 0000000000..341a24cff3 --- /dev/null +++ b/tests/Tree/negative/test011.jvt @@ -0,0 +1,5 @@ +-- calling unsupported anoma-encode + +function main() : * { + anoma-encode(1) +}