anoma/juvix
1
1
Fork 0
mirror of https://github.com/anoma/juvix.git synced 2025-01-04 05:33:27 +03:00
Code Issues Projects Releases Wiki Activity

Support Anoma stdlib curry function (#3097)

Browse Source 
This PR adds support for the Anoma node stdlib function to the nockma
backend.

https://developers.urbit.org/reference/hoon/stdlib/2n#cury

This PR also changes the arguments placeholder value when compiling
functions and closures to make it a tuple of length equal to the
function/closure arity.

To use curry, the function argument's placeholder argument tuple must
have length equal to the function airty.

For example if we are compiling a function with arity 2, the compiled
nock function should have the form:

```
[compiled-code [0 0] env]
```
This commit is contained in:
Paul Cadman 2024-10-11 15:53:06 +01:00 committed by GitHub
parent ec169a45cd
commit c499d0d7e1
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
5 changed files with 159 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
src/Juvix/Compiler/Nockma/Evaluator.hs
View File

@ -197,15 +197,18 @@ evalProfile inistack initerm =
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
-- can choose to use the raw call instead.
if
| intercept' -> goStdlibCall (o ^. stdlibCallCell)
| otherwise -> goOperatorCell (o ^. stdlibCallRaw)
| intercept' -> goStdlibCall nonInterceptCall (o ^. stdlibCallCell)
| otherwise -> nonInterceptCall
where
loc :: Maybe Interval
loc = term ^. termLoc
goStdlibCall :: StdlibCall a -> Sem r (Term a)
goStdlibCall StdlibCall {..} = do
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)
let binArith :: (a -> a -> a) -> Sem r (Term a)
@ -262,6 +265,9 @@ evalProfile inistack initerm =
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
where
goCat :: Atom a -> Atom a -> Sem r (Term a)
goCat arg1 arg2 = TermAtom . setAtomHint AtomHintString <$> atomConcatenateBytes arg1 arg2

1
src/Juvix/Compiler/Nockma/StdlibFunction.hs
View File

@ -27,6 +27,7 @@ stdlibPath = \case
StdlibSignDetached -> [nock| [9 23 0 1] |]
StdlibVerify -> [nock| [9 4 0 1] |]
StdlibLengthList -> [nock| [9 1.406 0 31] |]
StdlibCurry -> [nock| [9 4 0 31] |]
-- Obtained from the urbit dojo using:
--
-- => anoma !=(~(met block 3))

2
src/Juvix/Compiler/Nockma/StdlibFunction/Base.hs
View File

@ -24,6 +24,7 @@ instance Pretty StdlibFunction where
StdlibFoldBytes -> "fold-bytes"
StdlibLengthList -> "length-list"
StdlibLengthBytes -> "length-bytes"
StdlibCurry -> "curry"
data StdlibFunction
= StdlibDec
@ -45,6 +46,7 @@ data StdlibFunction
| StdlibFoldBytes
| StdlibLengthList
| StdlibLengthBytes
| StdlibCurry
deriving stock (Show, Lift, Eq, Bounded, Enum, Generic)
instance Hashable StdlibFunction

25
src/Juvix/Compiler/Nockma/Translation/FromTree.hs
View File

@ -31,6 +31,9 @@ module Juvix.Compiler.Nockma.Translation.FromTree
runCompilerWith,
emptyCompilerCtx,
CompilerCtx (..),
stdlibCurry,
IndexTupleArgs (..),
indexTuple,
)
where
@ -758,7 +761,7 @@ compile = \case
args <- mapM compile _nodeAllocClosureArgs
return . makeClosure $ \case
FunCode -> opAddress "allocClosureFunPath" (base <> fpath <> closurePath FunCode)
ArgsTuple -> OpQuote # argsTuplePlaceholder "goAllocClosure"
ArgsTuple -> OpQuote # argsTuplePlaceholder "goAllocClosure" farity
FunctionsLibrary -> OpQuote # functionsLibraryPlaceHolder
StandardLibrary -> OpQuote # stdlibPlaceHolder
ClosureTotalArgsNum -> nockNatLiteral farity
@ -784,8 +787,11 @@ compile = \case
opAddress' :: Term Natural -> Term Natural
opAddress' x = evaluated $ (opQuote "opAddress'" OpAddress) # x
argsTuplePlaceholder :: Text -> Term Natural
argsTuplePlaceholder txt = nockNilTagged ("argsTuplePlaceholder-" <> txt)
argsTuplePlaceholder :: Text -> Natural -> Term Natural
argsTuplePlaceholder txt arity = ("argsTuplePlaceholder-" <> txt) @ foldTermsOrNil (replicate arityInt (TermAtom nockNil))
where
arityInt :: Int
arityInt = fromIntegral arity
appendRights :: (Member (Reader CompilerCtx) r) => Path -> Term Natural -> Sem r (Term Natural)
appendRights path n = do
@ -975,18 +981,18 @@ runCompilerWith _opts constrs moduleFuns mainFun =
compiledFuns =
(OpQuote # (666 :: Natural)) -- TODO we have this unused term so that indices match. Remove it and adjust as needed
: ( makeLibraryFunction
<$> [(f ^. compilerFunctionName, runCompilerFunction compilerCtx f) | f <- libFuns]
<$> [(f ^. compilerFunctionName, f ^. compilerFunctionArity, runCompilerFunction compilerCtx f) | f <- libFuns]
)
makeLibraryFunction :: (Text, Term Natural) -> Term Natural
makeLibraryFunction (funName, c) =
makeLibraryFunction :: (Text, Natural, Term Natural) -> Term Natural
makeLibraryFunction (funName, funArity, c) =
("def-" <> funName)
@ makeClosure
( \p ->
let nockNilHere = nockNilTagged ("makeLibraryFunction-" <> show p)
in case p of
FunCode -> ("funCode-" <> funName) @ c
ArgsTuple -> ("argsTuple-" <> funName) @ argsTuplePlaceholder "libraryFunction"
ArgsTuple -> ("argsTuple-" <> funName) @ argsTuplePlaceholder "libraryFunction" funArity
FunctionsLibrary -> ("functionsLibrary-" <> funName) @ functionsLibraryPlaceHolder
StandardLibrary -> ("stdlib-" <> funName) @ stdlibPlaceHolder
ClosureTotalArgsNum -> ("closureTotalArgsNum-" <> funName) @ nockNilHere
@ -1000,7 +1006,7 @@ runCompilerWith _opts constrs moduleFuns mainFun =
let nockNilHere = nockNilTagged ("makeMainFunction-" <> show p)
in case p of
FunCode -> run . runReader compilerCtx $ mainFunctionWrapper funcsLib c
ArgsTuple -> argsTuplePlaceholder "mainFunction"
ArgsTuple -> argsTuplePlaceholder "mainFunction" (mainFun ^. compilerFunctionArity)
FunctionsLibrary -> functionsLibraryPlaceHolder
StandardLibrary -> stdlib
ClosureTotalArgsNum -> nockNilHere
@ -1304,3 +1310,6 @@ intToUInt8 i = callStdlib StdlibMod [i, nockIntegralLiteral @Natural (2 ^ uint8S
where
uint8Size :: Natural
uint8Size = 8
stdlibCurry :: (Member (Reader CompilerCtx) r) => Term Natural -> Term Natural -> Sem r (Term Natural)
stdlibCurry f arg = callStdlib StdlibCurry [f, arg]

130
test/Nockma/Eval/Positive.hs
View File

@ -159,6 +159,113 @@ testWithStorage s = Test defaultEvalOptions Nothing (Storage (HashMap.fromList (
test :: Text -> Term Natural -> Term Natural -> Check () -> Test
test = testWithStorage []
--- A Nock formula that computes logical and
nockAnd :: Term Natural
nockAnd =
OpIf
# (OpAddress # argPath 0)
# ( OpIf
# (OpAddress # argPath 1)
# nockTrueLiteral
# nockFalseLiteral
)
# nockFalseLiteral
where
argPath :: Natural -> Path
argPath idx =
closurePath ArgsTuple
++ indexTuple
( IndexTupleArgs
{ _indexTupleArgsIndex = idx,
_indexTupleArgsLength = funArity
}
)
funArity :: Natural
funArity = 2
--- A nock function that computes logical and
nockAndFun :: Term Natural
nockAndFun = nockAnd # args # env
where
arg :: Term Natural
arg = nockNilTagged "placeholder argument"
args :: Term Natural
args = arg # arg
env :: Term Natural
env = nockNilTagged "environment"
--- A Nock formula that computes logical and of 3 arguments
nockAnd3 :: Term Natural
nockAnd3 =
OpIf
# (OpAddress # argPath 0)
# ( OpIf
# (OpAddress # argPath 1)
# ( OpIf
# (OpAddress # argPath 2)
# nockTrueLiteral
# nockFalseLiteral
)
# nockFalseLiteral
)
# nockFalseLiteral
where
argPath :: Natural -> Path
argPath idx =
closurePath ArgsTuple
++ indexTuple
( IndexTupleArgs
{ _indexTupleArgsIndex = idx,
_indexTupleArgsLength = funArity
}
)
funArity :: Natural
funArity = 3
--- A nock function that computes logical and for 3 arguments
nockAnd3Fun :: Term Natural
nockAnd3Fun = nockAnd3 # args # env
where
arg :: Term Natural
arg = nockNilTagged "placeholder argument"
args :: Term Natural
args = arg # arg # arg
env :: Term Natural
env = nockNilTagged "environment"
-- | Wrap a function in a formula that calls the function with arguments from the subject.
applyFun :: Term Natural -> Term Natural
applyFun f =
OpPush
# f
# ( OpCall
# codePath
# ( OpReplace
# ( argsPath
# (OpAddress # subjectPath >># (OpAddress # argsPath))
)
# (OpAddress # fPath)
)
)
where
codePath :: Path
codePath = closurePath FunCode
argsPath :: Path
argsPath = closurePath ArgsTuple
-- Path to the function being applied after pushing
fPath :: Path
fPath = [L]
-- Path to the original subject after pushing
subjectPath :: Path
subjectPath = [R]
anomaCallingConventionTests :: [Test]
anomaCallingConventionTests =
[True, False]
@ -172,7 +279,24 @@ anomaCallingConventionTests =
in run . runReader fx . runReader emptyCompilerCtx $ do
p0 <- pathToArg 0
p1 <- pathToArg 1
return (anomaTestM "stdlib sub args" (sub (OpAddress # p0) (OpAddress # p1)) args (eqNock [nock| 2 |]))
return (anomaTestM "stdlib sub args" (sub (OpAddress # p0) (OpAddress # p1)) args (eqNock [nock| 2 |])),
--- sanity check nockAnd
anomaTestM "(and true false) == false" (return nockAnd) [nockTrueLiteral, nockFalseLiteral] (eqNock [nock| false |]),
anomaTestM "(and true true) == true" (return nockAnd) [nockTrueLiteral, nockTrueLiteral] (eqNock [nock| true |]),
--- test curry with and
anomaTestM "(curry and true) false == false" (applyFun <$> stdlibCurry (OpQuote # nockAndFun) nockTrueLiteral) [nockFalseLiteral] (eqNock [nock| false |]),
anomaTestM "(curry and true) true == true" (applyFun <$> stdlibCurry (OpQuote # nockAndFun) nockTrueLiteral) [nockTrueLiteral] (eqNock [nock| true |]),
anomaTestM "(curry and false) true == false" (applyFun <$> stdlibCurry (OpQuote # nockAndFun) nockFalseLiteral) [nockTrueLiteral] (eqNock [nock| false |]),
anomaTestM "(curry and false) false == false" (applyFun <$> stdlibCurry (OpQuote # nockAndFun) nockFalseLiteral) [nockFalseLiteral] (eqNock [nock| false |]),
--- sanity check nockAnd3
anomaTestM "(and3 true false true) == false" (return nockAnd3) [nockTrueLiteral, nockFalseLiteral, nockTrueLiteral] (eqNock [nock| false |]),
anomaTestM "(and3 true true false) == false" (return nockAnd3) [nockTrueLiteral, nockTrueLiteral, nockFalseLiteral] (eqNock [nock| false |]),
anomaTestM "(and3 true true true) == true" (return nockAnd3) [nockTrueLiteral, nockTrueLiteral, nockTrueLiteral] (eqNock [nock| true |]),
--- test curry with and3
anomaTestM "(curry and3 true) false true == false" (applyFun <$> stdlibCurry (OpQuote # nockAnd3Fun) nockTrueLiteral) [nockFalseLiteral, nockTrueLiteral] (eqNock [nock| false |]),
anomaTestM "(curry and3 true) true true == true" (applyFun <$> stdlibCurry (OpQuote # nockAnd3Fun) nockTrueLiteral) [nockTrueLiteral, nockTrueLiteral] (eqNock [nock| true |]),
anomaTestM "(curry and3 false) true true == false" (applyFun <$> stdlibCurry (OpQuote # nockAnd3Fun) nockFalseLiteral) [nockTrueLiteral, nockTrueLiteral] (eqNock [nock| false |]),
anomaTestM "(curry and3 false) false true == false" (applyFun <$> stdlibCurry (OpQuote # nockAnd3Fun) nockFalseLiteral) [nockFalseLiteral, nockTrueLiteral] (eqNock [nock| false |])
]
serializationTests :: [Test]
@ -232,6 +356,10 @@ serializationTests =
[nock| [[0 1] [2 3] [4 5] [6 7] [8 9] [10 11] [12 13] [14 15] [16 17] [18 19] [20 21] 0] |]
[nock| 308.947.677.754.874.070.959.300.747.182.056.036.528.545.493.781.368.831.595.479.491.505.523.344.414.501 |]
-- Call a formula with specified arguments
nockCall :: Term Natural -> NonEmpty (Term Natural) -> Term Natural
nockCall formula args = (OpReplace # ([R, L] # foldTerms args) # (OpQuote # formula)) >># (OpCall # [L] # (OpAddress # emptyPath))
juvixCallingConventionTests :: [Test]
juvixCallingConventionTests =
[True, False]