Host ABI definition and ergonomics in TC

This commit is contained in:
2026-05-09 18:33:03 -05:00
parent d0886ad886
commit 2e8a0a4c46
4 changed files with 542 additions and 52 deletions

View File

@@ -2795,4 +2795,65 @@ manifestReadingTests = testGroup "Manifest Reading Tests"
let env = evalTricu library (parseTricu input)
toString (result env) @?= Right "left"
close srcConn
, testCase "host ABI: constructors expose tag and payload" $ do
library <- evaluateFile "./lib/arboricx.tri"
let stringInput = "hostString \"hello\""
stringEnv = evalTricu library (parseTricu stringInput)
result stringEnv @?= pairT (ofNumber 1) (ofString "hello")
let tagEnv = evalTricu library (parseTricu "hostValueTag (hostNumber 42)")
result tagEnv @?= ofNumber 2
let payloadEnv = evalTricu library (parseTricu "hostValuePayload (hostBool true)")
result payloadEnv @?= trueT
, testCase "runArboricxToTree: wraps raw result as hostTree" $ do
(srcConn, termHash, originalTerm) <- storeTermInTempDB $ unlines
[ "main = t t" ]
wireData <- exportBundle srcConn [termHash]
let input = "matchResult "
++ " (code rest : err code rest) "
++ " (hostValue rest : ok hostValue []) "
++ " (runArboricxToTree " ++ bytesExpr (map toInteger $ BS.unpack wireData) ++ " [])"
library <- evaluateFile "./lib/arboricx.tri"
let env = evalTricu library (parseTricu input)
result env @?= okT (pairT (ofNumber 0) originalTerm) (bytesT [])
close srcConn
, testCase "runArboricxToString: wraps string result as hostString" $ do
(srcConn, termHash, _) <- storeTermInTempDB $ unlines
[ "main = (x : x)" ]
wireData <- exportBundle srcConn [termHash]
let input = "matchResult "
++ " (code rest : err code rest) "
++ " (hostValue rest : ok hostValue []) "
++ " (runArboricxToString " ++ bytesExpr (map toInteger $ BS.unpack wireData) ++ " [(\"hello\")])"
library <- evaluateFile "./lib/arboricx.tri"
let env = evalTricu library (parseTricu input)
result env @?= okT (pairT (ofNumber 1) (ofString "hello")) (bytesT [])
close srcConn
, testCase "runArboricxToNumber: wraps number result as hostNumber" $ do
(srcConn, termHash, _) <- storeTermInTempDB $ unlines
[ "main = 42" ]
wireData <- exportBundle srcConn [termHash]
let input = "matchResult "
++ " (code rest : err code rest) "
++ " (hostValue rest : ok hostValue []) "
++ " (runArboricxToNumber " ++ bytesExpr (map toInteger $ BS.unpack wireData) ++ " [])"
library <- evaluateFile "./lib/arboricx.tri"
let env = evalTricu library (parseTricu input)
result env @?= okT (pairT (ofNumber 2) (ofNumber 42)) (bytesT [])
close srcConn
, testCase "runArboricxToBool: rejects non-bool result" $ do
(srcConn, termHash, _) <- storeTermInTempDB $ unlines
[ "main = 42" ]
wireData <- exportBundle srcConn [termHash]
let input = "runArboricxToBool " ++ bytesExpr (map toInteger $ BS.unpack wireData) ++ " []"
library <- evaluateFile "./lib/arboricx.tri"
let env = evalTricu library (parseTricu input)
case result env of
Fork falseTag (Fork code _) | falseTag == falseT -> code @?= ofNumber 14
actual -> assertFailure $ "expected host codec error, got: " ++ show actual
close srcConn
]