diff --git a/bench2/Benchmark/Nockma/Encoding.hs b/bench2/Benchmark/Nockma/Encoding.hs index f8655a4436..7ae905a150 100644 --- a/bench2/Benchmark/Nockma/Encoding.hs +++ b/bench2/Benchmark/Nockma/Encoding.hs @@ -1,20 +1,20 @@ module Benchmark.Nockma.Encoding where +import Juvix.Compiler.Nockma.AnomaLib (anomaLib) import Juvix.Compiler.Nockma.Encoding import Juvix.Compiler.Nockma.Language -import Juvix.Compiler.Nockma.Stdlib (stdlib) import Juvix.Prelude.Base import Test.Tasty.Bench jamStdlib :: Natural -jamStdlib = runJam stdlib +jamStdlib = runJam anomaLib bm :: Benchmark bm = bgroup "Jam" - [ bench "jam stdlib" $ nf runJam stdlib, - bench "cue (jam stdlib)" $ nf runCue jamStdlib + [ bench "jam anomaLib" $ nf runJam anomaLib, + bench "cue (jam anomaLib)" $ nf runCue jamStdlib ] runJam :: Term Natural -> Natural diff --git a/runtime/nockma/README.md b/runtime/nockma/README.md index 41bff7de10..7d961f8010 100644 --- a/runtime/nockma/README.md +++ b/runtime/nockma/README.md @@ -1,11 +1,11 @@ ## Anoma Resource Machine Standard Library -The file `stdlib.nockma` is obtained from the [Anoma Node repository](https://github.com/anoma/anoma). +The file `anomalib.nockma` is obtained from the [Anoma Node repository](https://github.com/anoma/anoma). Follow the compilation instructions for Anoma and run the Elixir interactive shell in the root of the Anoma clone: ```sh iex -S mix -iex(1)> File.write("./stdlib.nockma", Nock.rm_core |> Noun.Format.print) +iex(1)> File.write("./anomalib.nockma", Nock.rm_core |> Noun.Format.print) ``` diff --git a/runtime/nockma/stdlib.nockma b/runtime/nockma/anomalib.nockma similarity index 100% rename from runtime/nockma/stdlib.nockma rename to runtime/nockma/anomalib.nockma diff --git a/src/Juvix/Compiler/Nockma/AnomaLib.hs b/src/Juvix/Compiler/Nockma/AnomaLib.hs new file mode 100644 index 0000000000..6913edf084 --- /dev/null +++ b/src/Juvix/Compiler/Nockma/AnomaLib.hs @@ -0,0 +1,104 @@ +module Juvix.Compiler.Nockma.AnomaLib where + +import Data.FileEmbed qualified as FE +import Juvix.Compiler.Nockma.Translation.FromSource +import Juvix.Prelude.Base + +anomaLib :: Term Natural +anomaLib = + fromRight impossible $ + parseText $ + decodeUtf8 $(FE.makeRelativeToProject "runtime/nockma/anomalib.nockma" >>= FE.embedFile) + +-- | The anoma lib paths are obtained from the Urbit dojo +-- * Load the anoma lib file into the Urbit dojo +-- * Run: `=> anoma !=(s)` where s is an anoma lib symbol +-- eg: +-- => anoma !=(add) +-- [9 20 0 15] +anomaLibPath :: AnomaLib -> Term Natural +anomaLibPath = \case + AnomaLibFunction (AnomaStdlibFunction f) -> case f of + StdlibDec -> [nock| [9 342 0 511] |] + StdlibAdd -> [nock| [9 20 0 511] |] + StdlibSub -> [nock| [9 47 0 511] |] + StdlibMul -> [nock| [9 4 0 511] |] + StdlibDiv -> [nock| [9 170 0 511] |] + StdlibMod -> [nock| [9 46 0 511] |] + StdlibLe -> [nock| [9 84 0 511] |] + StdlibLt -> [nock| [9 343 0 511] |] + -- pow2 is called bex in hoon + StdlibPow2 -> [nock| [9 4 0 63] |] + -- encode is called jam in hoon + StdlibEncode -> [nock| [9 22 0 31] |] + -- decode is called cue in hoon + StdlibDecode -> [nock| [9 94 0 31] |] + -- verifyDetached is called verify-detatched in hoon + StdlibVerifyDetached -> [nock| [9 22 0 15] |] + StdlibSign -> [nock| [9 10 0 15] |] + StdlibSignDetached -> [nock| [9 23 0 15] |] + StdlibVerify -> [nock| [9 4 0 15] |] + StdlibLengthList -> [nock| [9 1.406 0 255] |] + StdlibCurry -> [nock| [9 4 0 255] |] + -- sha256 is called shax in hoon + StdlibSha256 -> [nock| [9 22 0 7] |] + -- Obtained from the urbit dojo using: + -- + -- => anoma !=(~(met block 3)) + -- + -- The `3` here is because we want to treat each atom as sequences of 2^3 + -- bits, i.e bytes. + StdlibLengthBytes -> [nock| [8 [9 10 0 63] 9 190 10 [6 7 [0 3] 1 3] 0 2] |] + -- Obtained from the urbit dojo using: + -- + -- => anoma !=(~(cat block 3)) + -- + -- The `3` here is because we want to treat each atom as sequences of 2^3 + -- bits, i.e bytes. + StdlibCatBytes -> [nock| [8 [9 10 0 63] 9 4 10 [6 7 [0 3] 1 3] 0 2] |] + -- Obtained from the urbit dojo using: + -- + -- =>(anoma !=(|=([l=(list @)] (foldr l |=([fst=@ snd=@] (add (~(lsh block 3) 1 snd) fst)))))) + -- + -- The `3` here is because we want to shift left in byte = 2^3 bit steps. + StdlibFoldBytes -> + [nock| + [ 8 + [1 0] + [ 1 + 8 + [9 46 0 1.023] + 9 + 2 + 10 + [ 6 + [0 14] + 7 + [0 3] + 8 + [1 0 0] + [1 8 [9 20 0 8.191] 9 2 10 [6 [7 [0 3] 8 [8 [9 10 0 1.023] 9 90 10 [6 7 [0 3] 1 3] 0 2] 9 2 10 [6 [7 [0 3] 1 1] 0 29] 0 2] 0 28] 0 2] + 0 + 1 + ] + 0 + 2 + ] + 0 + 1 + ] + |] + AnomaLibFunction (AnomaRmFunction f) -> case f of + RmCommit -> [nock| [9 94 0 1] |] + RmNullify -> [nock| [9 350 0 1] |] + RmKind -> [nock| [9 1.492 0 1] |] + RmProveLogic -> [nock| [9 342 0 1] |] + RmProveAction -> [nock| [9 22 0 1] |] + RmDeltaAdd -> [nock| [9 92 0 1] |] + RmDeltaSub -> [nock| [9 763 0 1] |] + RmResourceDelta -> [nock| [9 343 0 1] |] + RmActionDelta -> [nock| [9 4 0 1] |] + RmMakeDelta -> [nock| [9 372 0 1] |] + RmProveDelta -> [nock| [9 1.535 0 1] |] + AnomaLibValue (AnomaRmValue v) -> case v of + RmZeroDelta -> [nock| [9 20 0 1] |] diff --git a/src/Juvix/Compiler/Nockma/AnomaLib/Base.hs b/src/Juvix/Compiler/Nockma/AnomaLib/Base.hs new file mode 100644 index 0000000000..2283c8b64f --- /dev/null +++ b/src/Juvix/Compiler/Nockma/AnomaLib/Base.hs @@ -0,0 +1,128 @@ +module Juvix.Compiler.Nockma.AnomaLib.Base where + +import Juvix.Prelude hiding (Atom, Path) +import Juvix.Prelude.Pretty + +data AnomaFunction + = AnomaStdlibFunction StdlibFunction + | AnomaRmFunction RmFunction + deriving stock (Show, Lift, Eq, Generic) + +instance Hashable AnomaFunction + +instance NFData AnomaFunction + +data StdlibFunction + = StdlibDec + | StdlibAdd + | StdlibSub + | StdlibMul + | StdlibDiv + | StdlibMod + | StdlibLt + | StdlibLe + | StdlibPow2 + | StdlibEncode + | StdlibDecode + | StdlibVerifyDetached + | StdlibSign + | StdlibSignDetached + | StdlibVerify + | StdlibCatBytes + | StdlibFoldBytes + | StdlibLengthList + | StdlibLengthBytes + | StdlibCurry + | StdlibSha256 + deriving stock (Show, Lift, Eq, Bounded, Enum, Generic) + +instance Hashable StdlibFunction + +instance NFData StdlibFunction + +-- | Anoma Resource Machine client library functions +data RmFunction + = RmCommit + | RmNullify + | RmKind + | RmProveLogic + | RmProveAction + | RmDeltaAdd + | RmDeltaSub + | RmResourceDelta + | RmActionDelta + | RmMakeDelta + | RmProveDelta + deriving stock (Show, Lift, Eq, Bounded, Enum, Generic) + +instance Hashable RmFunction + +instance NFData RmFunction + +newtype AnomaValue + = AnomaRmValue RmValue + deriving stock (Show, Lift, Eq, Generic) + +instance Hashable AnomaValue + +instance NFData AnomaValue + +-- | Anoma Resource Machine client library values +data RmValue + = RmZeroDelta + deriving stock (Show, Lift, Eq, Bounded, Enum, Generic) + +instance Hashable RmValue + +instance NFData RmValue + +data AnomaLib + = AnomaLibFunction AnomaFunction + | AnomaLibValue AnomaValue + deriving stock (Show, Lift, Eq, Generic) + +instance Hashable AnomaLib + +instance NFData AnomaLib + +instance Pretty StdlibFunction where + pretty = \case + StdlibDec -> "dec" + StdlibAdd -> "add" + StdlibSub -> "sub" + StdlibMul -> "mul" + StdlibDiv -> "div" + StdlibMod -> "mod" + StdlibLt -> "<" + StdlibLe -> "<=" + StdlibPow2 -> "pow2" + StdlibEncode -> "encode" + StdlibDecode -> "decode" + StdlibVerifyDetached -> "verify-detached" + StdlibSign -> "sign" + StdlibSignDetached -> "sign-detached" + StdlibVerify -> "verify" + StdlibCatBytes -> "cat" + StdlibFoldBytes -> "fold-bytes" + StdlibLengthList -> "length-list" + StdlibLengthBytes -> "length-bytes" + StdlibCurry -> "curry" + StdlibSha256 -> "sha256" + +instance Pretty RmFunction where + pretty = \case + RmCommit -> "commit" + RmNullify -> "nullify" + RmKind -> "kind" + RmProveLogic -> "prove-logic" + RmProveAction -> "prove-action" + RmDeltaAdd -> "delta-add" + RmDeltaSub -> "delta-sub" + RmResourceDelta -> "resource-delta" + RmActionDelta -> "action-delta" + RmMakeDelta -> "make-delta" + RmProveDelta -> "prove-delta" + +instance Pretty RmValue where + pretty = \case + RmZeroDelta -> "zero-delta" diff --git a/src/Juvix/Compiler/Nockma/Evaluator.hs b/src/Juvix/Compiler/Nockma/Evaluator.hs index cc364e3c27..bcae856bcf 100644 --- a/src/Juvix/Compiler/Nockma/Evaluator.hs +++ b/src/Juvix/Compiler/Nockma/Evaluator.hs @@ -104,18 +104,18 @@ parseCell :: Cell a -> Sem r (ParsedCell a) parseCell c = case c ^. cellLeft of - TermAtom a -> operatorOrStdlibCall a (c ^. cellRight) (c ^. cellCall) + TermAtom a -> operatorOrAnomaLibCall a (c ^. cellRight) (c ^. cellCall) TermCell l -> return (ParsedAutoConsCell (AutoConsCell l (c ^. cellRight))) where - operatorOrStdlibCall :: Atom a -> Term a -> Maybe (StdlibCall a) -> Sem r (ParsedCell a) - operatorOrStdlibCall a t mcall = do + operatorOrAnomaLibCall :: Atom a -> Term a -> Maybe (AnomaLibCall a) -> Sem r (ParsedCell a) + operatorOrAnomaLibCall a t mcall = do opCell <- parseOperatorCell a t return $ case mcall of Nothing -> ParsedOperatorCell opCell - Just call -> ParsedStdlibCallCell (parseStdlibCall opCell call) + Just call -> ParsedAnomaLibCallCell (parseAnomaLibCall opCell call) - parseStdlibCall :: OperatorCell a -> StdlibCall a -> StdlibCallCell a - parseStdlibCall op call = StdlibCallCell call op + parseAnomaLibCall :: OperatorCell a -> AnomaLibCall a -> AnomaLibCallCell a + parseAnomaLibCall op call = AnomaLibCallCell call op parseOperatorCell :: Atom a -> Term a -> Sem r (OperatorCell a) parseOperatorCell a t = do @@ -195,22 +195,22 @@ evalProfile inistack initerm = parseCell c >>= \case ParsedAutoConsCell a -> goAutoConsCell a ParsedOperatorCell o -> goOperatorCell o - ParsedStdlibCallCell o -> do - intercept' <- asks (^. evalInterceptStdlibCalls) - let nonInterceptCall = goOperatorCell (o ^. stdlibCallRaw) - -- Pass the raw call to goStdlibCall so that stdlib intercepts + ParsedAnomaLibCallCell o -> do + intercept' <- asks (^. evalInterceptAnomaLibCalls) + let nonInterceptCall = goOperatorCell (o ^. anomaLibCallRaw) + -- Pass the raw call to goAnomaLibCall so that stdlib intercepts -- can choose to use the raw call instead. if - | intercept' -> goStdlibCall nonInterceptCall (o ^. stdlibCallCell) + | intercept' -> goAnomaLibCall nonInterceptCall (o ^. anomaLibCallCell) | otherwise -> nonInterceptCall where loc :: Maybe Interval loc = term ^. termLoc - goStdlibCall :: Sem r (Term a) -> StdlibCall a -> Sem r (Term a) - goStdlibCall nonInterceptCall StdlibCall {..} = do - let w = EvalCrumbStdlibCallArgs (CrumbStdlibCallArgs _stdlibCallFunction) - args' <- withCrumb w (recEval stack _stdlibCallArgs) + goAnomaLibCall :: Sem r (Term a) -> AnomaLibCall a -> Sem r (Term a) + goAnomaLibCall nonInterceptCall AnomaLibCall {..} = do + let w = EvalCrumbAnomaLibCallArgs (CrumbAnomaLibCallArgs _anomaLibCallRef) + args' <- withCrumb w (recEval stack _anomaLibCallArgs) let binArith :: (a -> a -> a) -> Sem r (Term a) binArith f = case args' of TCell (TAtom l) (TAtom r) -> return (TAtom (f l r)) @@ -226,51 +226,55 @@ evalProfile inistack initerm = TCell (TAtom l) (TAtom r) -> return (TermAtom (nockBool (f l r))) _ -> error "expected a cell with two atoms" - case _stdlibCallFunction of - StdlibDec -> unaArith pred - StdlibAdd -> binArith (+) - StdlibMul -> binArith (*) - StdlibSub -> binArith (-) - StdlibDiv -> binArith div - StdlibMod -> binArith mod - StdlibLt -> binCmp (<) - StdlibLe -> binCmp (<=) - StdlibPow2 -> unaArith (2 ^) - StdlibEncode -> TermAtom <$> Encoding.jam args' - StdlibDecode -> case args' of - TermAtom a -> do - r <- Encoding.cueEither a - either (throwDecodingFailed args') return r - TermCell {} -> throwDecodingFailed args' DecodingErrorExpectedAtom - StdlibVerifyDetached -> case args' of - TCell (TermAtom sig) (TCell (TermAtom message) (TermAtom pubKey)) -> goVerifyDetached sig message pubKey - _ -> error "expected a term of the form [signature (atom) message (encoded term) public_key (atom)]" - StdlibSign -> case args' of - TCell (TermAtom message) (TermAtom privKey) -> goSign message privKey - _ -> error "expected a term of the form [message (encoded term) private_key (atom)]" - StdlibSignDetached -> case args' of - TCell (TermAtom message) (TermAtom privKey) -> goSignDetached message privKey - _ -> error "expected a term of the form [message (encoded term) private_key (atom)]" - StdlibVerify -> case args' of - TCell (TermAtom signedMessage) (TermAtom pubKey) -> goVerify signedMessage pubKey - _ -> error "expected a term of the form [signedMessage (atom) public_key (atom)]" - StdlibCatBytes -> case args' of - TCell (TermAtom arg1) (TermAtom arg2) -> goCat arg1 arg2 - _ -> error "expected a term with two atoms" - StdlibFoldBytes -> TermAtom <$> goFoldBytes args' - StdlibLengthList -> do - let xs = checkTermToList args' - let len = integerToNatural (toInteger (length xs)) - TermAtom . mkEmptyAtom <$> fromNatural len - StdlibLengthBytes -> case args' of - TermAtom a -> TermAtom <$> goLengthBytes a - _ -> error "expected an atom" - -- Use the raw nock code for curry. The nock stdlib curry function is - -- small. There's no benefit in implementing it separately in the evaluator. - StdlibCurry -> nonInterceptCall - StdlibSha256 -> case args' of - TermAtom a -> TermAtom <$> goSha256 a - _ -> error "StdlibSha256 expects to be called with an atom" + case _anomaLibCallRef of + AnomaLibValue (AnomaRmValue v) -> case v of + RmZeroDelta -> nonInterceptCall + AnomaLibFunction (AnomaRmFunction _) -> error "Resource Machine client library functions are not supported" + AnomaLibFunction (AnomaStdlibFunction f) -> case f of + StdlibDec -> unaArith pred + StdlibAdd -> binArith (+) + StdlibMul -> binArith (*) + StdlibSub -> binArith (-) + StdlibDiv -> binArith div + StdlibMod -> binArith mod + StdlibLt -> binCmp (<) + StdlibLe -> binCmp (<=) + StdlibPow2 -> unaArith (2 ^) + StdlibEncode -> TermAtom <$> Encoding.jam args' + StdlibDecode -> case args' of + TermAtom a -> do + r <- Encoding.cueEither a + either (throwDecodingFailed args') return r + TermCell {} -> throwDecodingFailed args' DecodingErrorExpectedAtom + StdlibVerifyDetached -> case args' of + TCell (TermAtom sig) (TCell (TermAtom message) (TermAtom pubKey)) -> goVerifyDetached sig message pubKey + _ -> error "expected a term of the form [signature (atom) message (encoded term) public_key (atom)]" + StdlibSign -> case args' of + TCell (TermAtom message) (TermAtom privKey) -> goSign message privKey + _ -> error "expected a term of the form [message (encoded term) private_key (atom)]" + StdlibSignDetached -> case args' of + TCell (TermAtom message) (TermAtom privKey) -> goSignDetached message privKey + _ -> error "expected a term of the form [message (encoded term) private_key (atom)]" + StdlibVerify -> case args' of + TCell (TermAtom signedMessage) (TermAtom pubKey) -> goVerify signedMessage pubKey + _ -> error "expected a term of the form [signedMessage (atom) public_key (atom)]" + StdlibCatBytes -> case args' of + TCell (TermAtom arg1) (TermAtom arg2) -> goCat arg1 arg2 + _ -> error "expected a term with two atoms" + StdlibFoldBytes -> TermAtom <$> goFoldBytes args' + StdlibLengthList -> do + let xs = checkTermToList args' + let len = integerToNatural (toInteger (length xs)) + TermAtom . mkEmptyAtom <$> fromNatural len + StdlibLengthBytes -> case args' of + TermAtom a -> TermAtom <$> goLengthBytes a + _ -> error "expected an atom" + -- Use the raw nock code for curry. The nock stdlib curry function is + -- small. There's no benefit in implementing it separately in the evaluator. + StdlibCurry -> nonInterceptCall + StdlibSha256 -> case args' of + TermAtom a -> TermAtom <$> goSha256 a + _ -> error "StdlibSha256 expects to be called with an atom" where goCat :: Atom a -> Atom a -> Sem r (Term a) goCat arg1 arg2 = TermAtom . setAtomHint AtomHintString <$> atomConcatenateBytes arg1 arg2 diff --git a/src/Juvix/Compiler/Nockma/Evaluator/Crumbs.hs b/src/Juvix/Compiler/Nockma/Evaluator/Crumbs.hs index 060ba51207..abe8ed5020 100644 --- a/src/Juvix/Compiler/Nockma/Evaluator/Crumbs.hs +++ b/src/Juvix/Compiler/Nockma/Evaluator/Crumbs.hs @@ -5,7 +5,7 @@ import Juvix.Compiler.Nockma.Pretty.Base import Juvix.Prelude hiding (Atom) data EvalCrumb - = EvalCrumbStdlibCallArgs CrumbStdlibCallArgs + = EvalCrumbAnomaLibCallArgs CrumbAnomaLibCallArgs | EvalCrumbOperator CrumbOperator | EvalCrumbAutoCons CrumbAutoCons @@ -16,8 +16,8 @@ newtype EvalCtx = EvalCtx topEvalCtx :: Sem (Reader EvalCtx ': r) a -> Sem r a topEvalCtx = runReader (EvalCtx []) -newtype CrumbStdlibCallArgs = CrumbStdlibCallArgs - { _crumbStdlibCallArgsFunction :: StdlibFunction +newtype CrumbAnomaLibCallArgs = CrumbAnomaLibCallArgs + { _crumbAnomaLibCallArgsFunction :: AnomaLib } newtype CrumbTag = CrumbTag {_crumbTag :: Text} @@ -69,9 +69,9 @@ instance PrettyCode CrumbTag where . annotate AnnImportant $ pretty a -instance PrettyCode CrumbStdlibCallArgs where - ppCode CrumbStdlibCallArgs {..} = do - op <- annotate AnnImportant <$> ppCode _crumbStdlibCallArgsFunction +instance PrettyCode CrumbAnomaLibCallArgs where + ppCode CrumbAnomaLibCallArgs {..} = do + op <- annotate AnnImportant <$> ppCode _crumbAnomaLibCallArgsFunction return ("Evaluating address to arguments to stdlib call for" <+> op) ppCtx :: (Member (Reader Options) r) => EvalCtx -> Sem r (Doc Ann) @@ -105,7 +105,7 @@ instance PrettyCode CrumbAutoCons where instance PrettyCode EvalCrumb where ppCode = \case EvalCrumbAutoCons a -> ppCode a - EvalCrumbStdlibCallArgs a -> ppCode a + EvalCrumbAnomaLibCallArgs a -> ppCode a EvalCrumbOperator a -> ppCode a instance PrettyCode EvalCtx where diff --git a/src/Juvix/Compiler/Nockma/Evaluator/Options.hs b/src/Juvix/Compiler/Nockma/Evaluator/Options.hs index 39bae81fc6..af10b38c7e 100644 --- a/src/Juvix/Compiler/Nockma/Evaluator/Options.hs +++ b/src/Juvix/Compiler/Nockma/Evaluator/Options.hs @@ -3,13 +3,13 @@ module Juvix.Compiler.Nockma.Evaluator.Options where import Juvix.Prelude.Base newtype EvalOptions = EvalOptions - { _evalInterceptStdlibCalls :: Bool + { _evalInterceptAnomaLibCalls :: Bool } defaultEvalOptions :: EvalOptions defaultEvalOptions = EvalOptions - { _evalInterceptStdlibCalls = True + { _evalInterceptAnomaLibCalls = True } makeLenses ''EvalOptions diff --git a/src/Juvix/Compiler/Nockma/Language.hs b/src/Juvix/Compiler/Nockma/Language.hs index 20e9d1ed36..be76c5b089 100644 --- a/src/Juvix/Compiler/Nockma/Language.hs +++ b/src/Juvix/Compiler/Nockma/Language.hs @@ -1,7 +1,7 @@ module Juvix.Compiler.Nockma.Language ( module Juvix.Compiler.Nockma.Language, module Juvix.Compiler.Core.Language.Base, - module Juvix.Compiler.Nockma.StdlibFunction.Base, + module Juvix.Compiler.Nockma.AnomaLib.Base, module Juvix.Compiler.Nockma.Language.Path, ) where @@ -9,8 +9,8 @@ where import Data.HashMap.Strict qualified as HashMap import GHC.Base (Type) import Juvix.Compiler.Core.Language.Base (Symbol) +import Juvix.Compiler.Nockma.AnomaLib.Base import Juvix.Compiler.Nockma.Language.Path -import Juvix.Compiler.Nockma.StdlibFunction.Base import Juvix.Prelude hiding (Atom, Path) import Juvix.Prelude.Pretty @@ -53,15 +53,15 @@ instance (Hashable a) => Hashable (Term a) instance (NFData a) => NFData (Term a) -data StdlibCall a = StdlibCall - { _stdlibCallFunction :: StdlibFunction, - _stdlibCallArgs :: Term a +data AnomaLibCall a = AnomaLibCall + { _anomaLibCallRef :: AnomaLib, + _anomaLibCallArgs :: Term a } deriving stock (Show, Eq, Lift, Generic) -instance (Hashable a) => Hashable (StdlibCall a) +instance (Hashable a) => Hashable (AnomaLibCall a) -instance (NFData a) => NFData (StdlibCall a) +instance (NFData a) => NFData (AnomaLibCall a) newtype Tag = Tag { _unTag :: Text @@ -75,7 +75,7 @@ instance NFData Tag data CellInfo a = CellInfo { _cellInfoLoc :: Irrelevant (Maybe Interval), _cellInfoTag :: Maybe Tag, - _cellInfoCall :: Maybe (StdlibCall a) + _cellInfoCall :: Maybe (AnomaLibCall a) } deriving stock (Show, Eq, Lift, Generic) @@ -176,12 +176,36 @@ textToStdlibFunctionMap = parseStdlibFunction :: Text -> Maybe StdlibFunction parseStdlibFunction t = textToStdlibFunctionMap ^. at t +textToRmFunctionMap :: HashMap Text RmFunction +textToRmFunctionMap = + hashMap + [ (prettyText f, f) | f <- allElements + ] + +parseRmFunction :: Text -> Maybe RmFunction +parseRmFunction t = textToRmFunctionMap ^. at t + +textToRmValueMap :: HashMap Text RmValue +textToRmValueMap = + hashMap + [ (prettyText f, f) | f <- allElements + ] + +parseRmValue :: Text -> Maybe RmValue +parseRmValue t = textToRmValueMap ^. at t + +parseAnomaLib :: Text -> Maybe AnomaLib +parseAnomaLib t = + AnomaLibFunction . AnomaStdlibFunction <$> parseStdlibFunction t + <|> AnomaLibFunction . AnomaRmFunction <$> parseRmFunction t + <|> AnomaLibValue . AnomaRmValue <$> parseRmValue t + atomOps :: HashMap Text NockOp atomOps = HashMap.fromList [(prettyText op, op) | op <- allElements] -data StdlibCallCell a = StdlibCallCell - { _stdlibCallCell :: StdlibCall a, - _stdlibCallRaw :: OperatorCell a +data AnomaLibCallCell a = AnomaLibCallCell + { _anomaLibCallCell :: AnomaLibCall a, + _anomaLibCallRaw :: OperatorCell a } data OperatorCell a = OperatorCell @@ -198,7 +222,7 @@ data AutoConsCell a = AutoConsCell data ParsedCell a = ParsedOperatorCell (OperatorCell a) | ParsedAutoConsCell (AutoConsCell a) - | ParsedStdlibCallCell (StdlibCallCell a) + | ParsedAnomaLibCallCell (AnomaLibCallCell a) -- | appends n R encodedPathAppendRightN :: Natural -> EncodedPath -> EncodedPath @@ -210,8 +234,8 @@ encodedPathAppendRightN n (EncodedPath p) = EncodedPath (f p) makeLenses ''Cell makeLenses ''Tag -makeLenses ''StdlibCallCell -makeLenses ''StdlibCall +makeLenses ''AnomaLibCallCell +makeLenses ''AnomaLibCall makeLenses ''Atom makeLenses ''OperatorCell makeLenses ''AutoConsCell @@ -243,7 +267,7 @@ cellLoc = cellInfo . cellInfoLoc . unIrrelevant cellTag :: Lens' (Cell a) (Maybe Tag) cellTag = cellInfo . cellInfoTag -cellCall :: Lens' (Cell a) (Maybe (StdlibCall a)) +cellCall :: Lens' (Cell a) (Maybe (AnomaLibCall a)) cellCall = cellInfo . cellInfoCall atomTag :: Lens' (Atom a) (Maybe Tag) diff --git a/src/Juvix/Compiler/Nockma/Pretty/Base.hs b/src/Juvix/Compiler/Nockma/Pretty/Base.hs index b164fa81b3..0b8eb23336 100644 --- a/src/Juvix/Compiler/Nockma/Pretty/Base.hs +++ b/src/Juvix/Compiler/Nockma/Pretty/Base.hs @@ -71,13 +71,33 @@ instance PrettyCode NockOp where ppCode = return . annotate (AnnKind KNameFunction) . pretty +instance PrettyCode AnomaFunction where + ppCode = \case + AnomaStdlibFunction f -> ppCode f + AnomaRmFunction f -> ppCode f + +instance PrettyCode AnomaValue where + ppCode = \case + AnomaRmValue v -> ppCode v + instance PrettyCode StdlibFunction where ppCode = return . pretty -instance (PrettyCode a, NockNatural a) => PrettyCode (StdlibCall a) where +instance PrettyCode RmFunction where + ppCode = return . pretty + +instance PrettyCode RmValue where + ppCode = return . pretty + +instance PrettyCode AnomaLib where + ppCode = \case + AnomaLibFunction f -> ppCode f + AnomaLibValue v -> ppCode v + +instance (PrettyCode a, NockNatural a) => PrettyCode (AnomaLibCall a) where ppCode c = do - fun <- ppCode (c ^. stdlibCallFunction) - args <- ppCode (c ^. stdlibCallArgs) + fun <- ppCode (c ^. anomaLibCallRef) + args <- ppCode (c ^. anomaLibCallArgs) return (Str.stdlibTag <> fun <+> Str.argsTag <> args) instance PrettyCode Tag where @@ -89,7 +109,7 @@ instance (PrettyCode a, NockNatural a) => PrettyCode (Cell a) where label <- runFail $ do failWhenM (asks (^. optIgnoreTags)) failMaybe (c ^. cellTag) >>= ppCode - stdlibCall <- runFail $ do + anomaLibCall <- runFail $ do failWhenM (asks (^. optIgnoreHints)) failMaybe (c ^. cellCall) >>= ppCode components <- case m of @@ -98,7 +118,7 @@ instance (PrettyCode a, NockNatural a) => PrettyCode (Cell a) where r' <- ppCode (c ^. cellRight) return (l' <+> r') MinimizeDelimiters -> sep <$> mapM ppCode (unfoldCell c) - let inside = label stdlibCall components + let inside = label anomaLibCall components return (oneLineOrNextBrackets inside) unfoldCell :: Cell a -> NonEmpty (Term a) diff --git a/src/Juvix/Compiler/Nockma/Stdlib.hs b/src/Juvix/Compiler/Nockma/Stdlib.hs deleted file mode 100644 index b58618be43..0000000000 --- a/src/Juvix/Compiler/Nockma/Stdlib.hs +++ /dev/null @@ -1,11 +0,0 @@ -module Juvix.Compiler.Nockma.Stdlib where - -import Data.FileEmbed qualified as FE -import Juvix.Compiler.Nockma.Translation.FromSource -import Juvix.Prelude.Base - -stdlib :: Term Natural -stdlib = - fromRight impossible $ - parseText $ - decodeUtf8 $(FE.makeRelativeToProject "runtime/nockma/stdlib.nockma" >>= FE.embedFile) diff --git a/src/Juvix/Compiler/Nockma/StdlibFunction.hs b/src/Juvix/Compiler/Nockma/StdlibFunction.hs deleted file mode 100644 index 05824aa291..0000000000 --- a/src/Juvix/Compiler/Nockma/StdlibFunction.hs +++ /dev/null @@ -1,82 +0,0 @@ -module Juvix.Compiler.Nockma.StdlibFunction where - -import Juvix.Compiler.Nockma.Translation.FromSource.QQ -import Juvix.Prelude.Base - --- | The stdlib paths are obtained from the Urbit dojo --- * Load the stdlib file into the Urbit dojo --- * Run: `=> anoma !=(s)` where s is a stdlib symbol --- eg: --- => anoma !=(add) --- [9 20 0 15] -stdlibPath :: StdlibFunction -> Term Natural -stdlibPath = \case - StdlibDec -> [nock| [9 342 0 511] |] - StdlibAdd -> [nock| [9 20 0 511] |] - StdlibSub -> [nock| [9 47 0 511] |] - StdlibMul -> [nock| [9 4 0 511] |] - StdlibDiv -> [nock| [9 170 0 511] |] - StdlibMod -> [nock| [9 46 0 511] |] - StdlibLe -> [nock| [9 84 0 511] |] - StdlibLt -> [nock| [9 343 0 511] |] - -- pow2 is called bex in hoon - StdlibPow2 -> [nock| [9 4 0 63] |] - -- encode is called jam in hoon - StdlibEncode -> [nock| [9 22 0 31] |] - -- decode is called cue in hoon - StdlibDecode -> [nock| [9 94 0 31] |] - -- verifyDetached is called verify-detatched in hoon - StdlibVerifyDetached -> [nock| [9 22 0 15] |] - StdlibSign -> [nock| [9 10 0 15] |] - StdlibSignDetached -> [nock| [9 23 0 15] |] - StdlibVerify -> [nock| [9 4 0 15] |] - StdlibLengthList -> [nock| [9 1.406 0 255] |] - StdlibCurry -> [nock| [9 4 0 255] |] - -- sha256 is called shax in hoon - StdlibSha256 -> [nock| [9 22 0 7] |] - -- Obtained from the urbit dojo using: - -- - -- => anoma !=(~(met block 3)) - -- - -- The `3` here is because we want to treat each atom as sequences of 2^3 - -- bits, i.e bytes. - StdlibLengthBytes -> [nock| [8 [9 10 0 63] 9 190 10 [6 7 [0 3] 1 3] 0 2] |] - -- Obtained from the urbit dojo using: - -- - -- => anoma !=(~(cat block 3)) - -- - -- The `3` here is because we want to treat each atom as sequences of 2^3 - -- bits, i.e bytes. - StdlibCatBytes -> [nock| [8 [9 10 0 63] 9 4 10 [6 7 [0 3] 1 3] 0 2] |] - -- Obtained from the urbit dojo using: - -- - -- =>(anoma !=(|=([l=(list @)] (foldr l |=([fst=@ snd=@] (add (~(lsh block 3) 1 snd) fst)))))) - -- - -- The `3` here is because we want to shift left in byte = 2^3 bit steps. - StdlibFoldBytes -> - [nock| - [ 8 - [1 0] - [ 1 - 8 - [9 46 0 1.023] - 9 - 2 - 10 - [ 6 - [0 14] - 7 - [0 3] - 8 - [1 0 0] - [1 8 [9 20 0 8.191] 9 2 10 [6 [7 [0 3] 8 [8 [9 10 0 1.023] 9 90 10 [6 7 [0 3] 1 3] 0 2] 9 2 10 [6 [7 [0 3] 1 1] 0 29] 0 2] 0 28] 0 2] - 0 - 1 - ] - 0 - 2 - ] - 0 - 1 - ] - |] diff --git a/src/Juvix/Compiler/Nockma/StdlibFunction/Base.hs b/src/Juvix/Compiler/Nockma/StdlibFunction/Base.hs deleted file mode 100644 index 6d00c05749..0000000000 --- a/src/Juvix/Compiler/Nockma/StdlibFunction/Base.hs +++ /dev/null @@ -1,56 +0,0 @@ -module Juvix.Compiler.Nockma.StdlibFunction.Base where - -import Juvix.Prelude hiding (Atom, Path) -import Juvix.Prelude.Pretty - -instance Pretty StdlibFunction where - pretty = \case - StdlibDec -> "dec" - StdlibAdd -> "add" - StdlibSub -> "sub" - StdlibMul -> "mul" - StdlibDiv -> "div" - StdlibMod -> "mod" - StdlibLt -> "<" - StdlibLe -> "<=" - StdlibPow2 -> "pow2" - StdlibEncode -> "encode" - StdlibDecode -> "decode" - StdlibVerifyDetached -> "verify-detached" - StdlibSign -> "sign" - StdlibSignDetached -> "sign-detached" - StdlibVerify -> "verify" - StdlibCatBytes -> "cat" - StdlibFoldBytes -> "fold-bytes" - StdlibLengthList -> "length-list" - StdlibLengthBytes -> "length-bytes" - StdlibCurry -> "curry" - StdlibSha256 -> "sha256" - -data StdlibFunction - = StdlibDec - | StdlibAdd - | StdlibSub - | StdlibMul - | StdlibDiv - | StdlibMod - | StdlibLt - | StdlibLe - | StdlibPow2 - | StdlibEncode - | StdlibDecode - | StdlibVerifyDetached - | StdlibSign - | StdlibSignDetached - | StdlibVerify - | StdlibCatBytes - | StdlibFoldBytes - | StdlibLengthList - | StdlibLengthBytes - | StdlibCurry - | StdlibSha256 - deriving stock (Show, Lift, Eq, Bounded, Enum, Generic) - -instance Hashable StdlibFunction - -instance NFData StdlibFunction diff --git a/src/Juvix/Compiler/Nockma/Translation/FromSource/Base.hs b/src/Juvix/Compiler/Nockma/Translation/FromSource/Base.hs index e1d8e44f10..59f8e61ff4 100644 --- a/src/Juvix/Compiler/Nockma/Translation/FromSource/Base.hs +++ b/src/Juvix/Compiler/Nockma/Translation/FromSource/Base.hs @@ -182,7 +182,7 @@ cell :: Parser (Cell Natural) cell = do lloc <- onlyInterval lsbracket lbl <- optional pTag - c <- optional stdlibCall + c <- optional anomaLibCall firstTerm <- term restTerms <- some term rloc <- onlyInterval rsbracket @@ -195,23 +195,23 @@ cell = do } return (set cellInfo info r) where - stdlibCall :: Parser (StdlibCall Natural) - stdlibCall = do + anomaLibCall :: Parser (AnomaLibCall Natural) + anomaLibCall = do chunk Str.stdlibTag f <- stdlibFun chunk Str.argsTag args <- term return - StdlibCall - { _stdlibCallArgs = args, - _stdlibCallFunction = f + AnomaLibCall + { _anomaLibCallArgs = args, + _anomaLibCallRef = f } - stdlibFun :: Parser StdlibFunction + stdlibFun :: Parser AnomaLib stdlibFun = do i <- iden let err = error ("invalid stdlib function identifier: " <> i) - maybe err return (parseStdlibFunction i) + maybe err return (parseAnomaLib i) buildCell :: Term Natural -> NonEmpty (Term Natural) -> Cell Natural buildCell h = \case diff --git a/src/Juvix/Compiler/Nockma/Translation/FromTree.hs b/src/Juvix/Compiler/Nockma/Translation/FromTree.hs index 50eed30cf7..152ce86994 100644 --- a/src/Juvix/Compiler/Nockma/Translation/FromTree.hs +++ b/src/Juvix/Compiler/Nockma/Translation/FromTree.hs @@ -16,6 +16,7 @@ module Juvix.Compiler.Nockma.Translation.FromTree nockNatLiteral, nockIntegralLiteral, callStdlib, + rmValue, foldTerms, pathToArg, makeList, @@ -30,12 +31,11 @@ where import Data.ByteString qualified as BS import Data.HashMap.Strict qualified as HashMap +import Juvix.Compiler.Nockma.AnomaLib import Juvix.Compiler.Nockma.Encoding import Juvix.Compiler.Nockma.Encoding.Ed25519 qualified as E import Juvix.Compiler.Nockma.Language.Path import Juvix.Compiler.Nockma.Pretty -import Juvix.Compiler.Nockma.Stdlib -import Juvix.Compiler.Nockma.StdlibFunction import Juvix.Compiler.Pipeline.EntryPoint import Juvix.Compiler.Tree.Data.InfoTable qualified as Tree import Juvix.Compiler.Tree.Language qualified as Tree @@ -147,7 +147,7 @@ data CompilerFunction = CompilerFunction -- respectively. This is because the stack must have the structure of a Nock -- function, i.e [code args env] -- --- The StandardLibrary constructor must be last. Anoma will replace the tail of +-- The AnomaLibrary constructor must be last. Anoma will replace the tail of -- the main function with the Anoma Resource Machine standard library when it -- calls it. data AnomaCallablePathId @@ -156,7 +156,7 @@ data AnomaCallablePathId | --- ClosureRemainingArgsNum | FunctionsLibrary - | StandardLibrary + | AnomaLibrary deriving stock (Enum, Bounded, Eq, Show) indexStack :: Natural -> Path @@ -773,9 +773,9 @@ compile = \case farity <- getFunctionArity fun args <- mapM compile _nodeAllocClosureArgs let funLib = opAddress "functionsLibrary" (base <> closurePath FunctionsLibrary) - stdLib = opAddress "standardLibrary" (base <> closurePath StandardLibrary) + anomaLibrary = opAddress "anomaLibrary" (base <> closurePath AnomaLibrary) closure = - opReplace "putStdLib" (closurePath StandardLibrary) stdLib + opReplace "putAnomaLib" (closurePath AnomaLibrary) anomaLibrary . opReplace "putFunLib" (closurePath FunctionsLibrary) funLib $ opAddress "goAllocClosure-getFunction" (base <> fpath) newArity = farity - fromIntegral (length args) @@ -825,7 +825,7 @@ nockIntegralLiteral = (OpQuote #) . toNock @Natural . fromIntegral -- [call L [replace [RL [seq [@ R] a]] [@ (locStdlib <> fPath)]]] ? -- --- Calling convention for Anoma stdlib +-- Calling convention for Anoma library -- -- [push -- [seq [@ locStdlib] getF] :: Obtain the function f within the stdlib. @@ -838,10 +838,11 @@ nockIntegralLiteral = (OpQuote #) . toNock @Natural . fromIntegral -- @ L] :: this whole replace is editing what's at axis L, i.e. what was pushed -- ] -- ] -callStdlib :: (Member (Reader CompilerCtx) r) => StdlibFunction -> [Term Natural] -> Sem r (Term Natural) -callStdlib fun args = do - stdpath <- stackPath StandardLibrary - let fPath = stdlibPath fun +callAnomaLib :: (Member (Reader CompilerCtx) r) => AnomaFunction -> [Term Natural] -> Sem r (Term Natural) +callAnomaLib fun args = do + stdpath <- stackPath AnomaLibrary + let ref = AnomaLibFunction fun + fPath = anomaLibPath ref getFunCode = opAddress "callStdlibFunCode" stdpath >># fPath argsPath <- stackPath ArgsTuple let adjustArgs = case nonEmpty args of @@ -849,13 +850,36 @@ callStdlib fun args = do Nothing -> opAddress "adjustArgsNothing" [L] callFn = opCall "callStdlib" (closurePath FunCode) adjustArgs meta = - StdlibCall - { _stdlibCallArgs = foldTermsOrQuotedNil args, - _stdlibCallFunction = fun + AnomaLibCall + { _anomaLibCallArgs = foldTermsOrQuotedNil args, + _anomaLibCallRef = ref } callCell = set cellCall (Just meta) (OpPush #. (getFunCode # callFn)) in return $ TermCell callCell +-- | Convenience function to call an Anoma stdlib function +callStdlib :: (Member (Reader CompilerCtx) r) => StdlibFunction -> [Term Natural] -> Sem r (Term Natural) +callStdlib f = callAnomaLib (AnomaStdlibFunction f) + +-- | Get a value from the Anoma library +anomaLibValue :: (Member (Reader CompilerCtx) r) => AnomaValue -> Sem r (Term Natural) +anomaLibValue v = do + stdpath <- stackPath AnomaLibrary + let ref = AnomaLibValue v + vPath = anomaLibPath ref + value = opAddress "rmValueValue" stdpath >>#. vPath + meta = + AnomaLibCall + { _anomaLibCallArgs = OpQuote # nockNilTagged "anomaLibCallValueArgs", + _anomaLibCallRef = ref + } + callCell = set cellCall (Just meta) value + return $ TermCell callCell + +-- | A Convenience function to get an Anoma resource machine value +rmValue :: (Member (Reader CompilerCtx) r) => RmValue -> Sem r (Term Natural) +rmValue v = anomaLibValue (AnomaRmValue v) + constUnit :: Term Natural constUnit = constVoid @@ -983,7 +1007,7 @@ runCompilerWith _opts constrs moduleFuns mainFun = ArgsTuple -> ("argsTuple-" <> funName) @ argsTuplePlaceholder "libraryFunction" funArity ClosureRemainingArgsNum -> ("closureRemainingArgsNum-" <> funName) @ nockNilHere FunctionsLibrary -> ("functionsLibrary-" <> funName) @ functionsLibraryPlaceHolder - StandardLibrary -> ("stdlib-" <> funName) @ stdlibPlaceHolder + AnomaLibrary -> ("stdlib-" <> funName) @ anomaLibPlaceholder ) -- The result is not quoted and cannot be evaluated directly. @@ -995,7 +1019,7 @@ runCompilerWith _opts constrs moduleFuns mainFun = ArgsTuple -> argsTuplePlaceholder "mainFunction" (mainFun ^. compilerFunctionArity) ClosureRemainingArgsNum -> nockNilHere FunctionsLibrary -> functionsLibraryPlaceHolder - StandardLibrary -> stdlib + AnomaLibrary -> anomaLib functionInfos :: HashMap FunctionId FunctionInfo functionInfos = hashMap (run (runStreamOfNaturals (toList <$> userFunctions))) @@ -1012,8 +1036,8 @@ runCompilerWith _opts constrs moduleFuns mainFun = } ) -stdlibPlaceHolder :: Term Natural -stdlibPlaceHolder = +anomaLibPlaceholder :: Term Natural +anomaLibPlaceholder = TermAtom Atom { _atomInfo = @@ -1082,7 +1106,7 @@ curryClosure f args newArity = do -- The functions library and the standard library are always taken from the -- closure `f`. The environment of `f` is used when evaluating the call. FunctionsLibrary -> OpQuote # functionsLibraryPlaceHolder - StandardLibrary -> OpQuote # stdlibPlaceHolder + AnomaLibrary -> OpQuote # anomaLibPlaceholder replaceSubject :: (Member (Reader CompilerCtx) r) => (AnomaCallablePathId -> Maybe (Term Natural)) -> Sem r (Term Natural) replaceSubject = replaceSubject' "replaceSubject" diff --git a/test/Nockma/Eval/Positive.hs b/test/Nockma/Eval/Positive.hs index 8cf43dff0c..ddc9d08165 100644 --- a/test/Nockma/Eval/Positive.hs +++ b/test/Nockma/Eval/Positive.hs @@ -4,10 +4,10 @@ import Base hiding (Path, testName) import Data.HashMap.Strict qualified as HashMap import Juvix.Compiler.Core.Language.Base (defaultSymbol) import Juvix.Compiler.Nockma.Anoma +import Juvix.Compiler.Nockma.AnomaLib (anomaLib) import Juvix.Compiler.Nockma.Evaluator import Juvix.Compiler.Nockma.Language import Juvix.Compiler.Nockma.Pretty -import Juvix.Compiler.Nockma.Stdlib (stdlib) import Juvix.Compiler.Nockma.Translation.FromSource.QQ import Juvix.Compiler.Nockma.Translation.FromTree @@ -88,8 +88,8 @@ eqTraces expected = do assertFailure (unpack msg) compilerTest :: Text -> Term Natural -> Check () -> Bool -> Test -compilerTest n mainFun _testCheck _evalInterceptStdlibCalls = - anomaTest n mainFun [] _testCheck _evalInterceptStdlibCalls +compilerTest n mainFun _testCheck _evalInterceptAnomaLibCalls = + anomaTest n mainFun [] _testCheck _evalInterceptAnomaLibCalls compilerTestM :: Text -> Sem '[Reader CompilerCtx] (Term Natural) -> Check () -> Bool -> Test compilerTestM n mainFun = @@ -126,7 +126,7 @@ withAssertErrKeyNotInStorage Test {..} = _ -> assertFailure "Expected ErrKeyNotInStorage error" anomaTest :: Text -> Term Natural -> [Term Natural] -> Check () -> Bool -> Test -anomaTest n mainFun args _testCheck _evalInterceptStdlibCalls = +anomaTest n mainFun args _testCheck _evalInterceptAnomaLibCalls = let f = CompilerFunction { _compilerFunctionId = UserFunction (defaultSymbol 0), @@ -135,7 +135,7 @@ anomaTest n mainFun args _testCheck _evalInterceptStdlibCalls = _compilerFunctionName = "main" } _testName :: Text - | _evalInterceptStdlibCalls = n <> " - intercept stdlib" + | _evalInterceptAnomaLibCalls = n <> " - intercept stdlib" | otherwise = n opts = CompilerOptions @@ -307,8 +307,8 @@ anomaCallingConventionTests = serializationTests :: [Test] serializationTests = serializationIdTest - "stdlib" - stdlib + "anomaLib" + anomaLib : serializationTest [nock| 0 |] [nock| 2 |] @@ -395,7 +395,8 @@ juvixCallingConventionTests = compilerTestM "length-bytes 256 == 2" (callStdlib StdlibLengthBytes [nockNatLiteral 256]) (eqNock [nock| 2 |]), compilerTestM "length-bytes 255 == 1" (callStdlib StdlibLengthBytes [nockNatLiteral 255]) (eqNock [nock| 1 |]), compilerTestM "length-bytes 1 == 1" (callStdlib StdlibLengthBytes [nockNatLiteral 1]) (eqNock [nock| 1 |]), - compilerTestM "length-bytes 0 == 0" (callStdlib StdlibLengthBytes [nockNatLiteral 0]) (eqNock [nock| 0 |]) + compilerTestM "length-bytes 0 == 0" (callStdlib StdlibLengthBytes [nockNatLiteral 0]) (eqNock [nock| 0 |]), + compilerTestM "zero-delta == 0" (rmValue RmZeroDelta) (eqNock [nock| 0 |]) ] unitTests :: [Test]