3 Commits

Author SHA1 Message Date
d9f25a2b5a Add Arborix bundle parsing and reconstruction
Implement portable Arborix container, section directory, nodes section, and
Merkle DAG reconstruction utilities in tricu libraries. Add byte/list helper
fixes needed for data-first recursion, validate node payloads, duplicate hashes,
and closed child references, and expose executable loading from a root hash.

Expand binary reader coverage with portable header/section tests, nodes-section
parsing, fixture bundle parsing, and execution checks for reconstructed
id/not?/map roots. Refresh fixture bundles and remove obsolete fixtures.
2026-05-07 14:21:24 -05:00
a002365651 Add Arborix section directory byte readers 2026-05-07 12:28:14 -05:00
1d84bf7cfa fix: freeVars, toSKIDB
freeVars did not descend into TStem, TFork, or SList, so dependency analysis
under structural nodes and lists was silently missed.

toSKIDB's _other = _K `SApp` TLeaf fallback returned a constant leaf when the
binder occurred under a structural node, losing the abstraction entirely.
Replace with explicit lowering: BStem/BFork/BList are converted to application
form before SKI abstraction, and any other unsupported DB term errors explicitly
2026-05-07 11:04:29 -05:00
13 changed files with 1340 additions and 260 deletions

View File

@@ -4,6 +4,21 @@
!import "binary.tri" !Local !import "binary.tri" !Local
arborixMagic = [(65) (82) (66) (79) (82) (73) (88) (0)] arborixMagic = [(65) (82) (66) (79) (82) (73) (88) (0)]
arborixMajorVersion = [(0) (1)]
arborixMinorVersion = [(0) (0)]
arborixManifestSectionId = [(0) (0) (0) (1)]
arborixNodesSectionId = [(0) (0) (0) (2)]
errMissingSection = 4
errUnsupportedVersion = 5
errDuplicateSection = 6
errDuplicateNode = 7
errInvalidNodePayload = 8
errMissingNode = 9
nodePayloadLeafTag = 0
nodePayloadStemTag = 1
nodePayloadForkTag = 2
readArborixMagic = (bs : expectBytes arborixMagic bs) readArborixMagic = (bs : expectBytes arborixMagic bs)
@@ -16,7 +31,624 @@ readArborixHeader = (bs :
(minorVersion afterMinor : (minorVersion afterMinor :
bindResult (readBytes 4 afterMinor) bindResult (readBytes 4 afterMinor)
(sectionCount afterSectionCount : (sectionCount afterSectionCount :
ok bindResult (readBytes 8 afterSectionCount)
(pair majorVersion (flags afterFlags :
(pair minorVersion sectionCount)) bindResult (readBytes 8 afterFlags)
afterSectionCount))))) (dirOffset afterDirOffset :
ok
(pair majorVersion
(pair minorVersion
(pair sectionCount
(pair flags dirOffset))))
afterDirOffset)))))))
readSectionRecord = (bs :
bindResult (readBytes 4 bs)
(sectionId afterSectionId :
bindResult (readBytes 2 afterSectionId)
(sectionVersion afterSectionVersion :
bindResult (readBytes 2 afterSectionVersion)
(sectionFlags afterSectionFlags :
bindResult (readBytes 2 afterSectionFlags)
(compression afterCompression :
bindResult (readBytes 2 afterCompression)
(digestAlgorithm afterDigestAlgorithm :
bindResult (readBytes 8 afterDigestAlgorithm)
(offset afterOffset :
bindResult (readBytes 8 afterOffset)
(length afterLength :
bindResult (readBytes 32 afterLength)
(digest afterDigest :
ok
(pair sectionId
(pair sectionVersion
(pair sectionFlags
(pair compression
(pair digestAlgorithm
(pair offset
(pair length digest)))))))
afterDigest)))))))))
readSectionDirectory_ = y (self bs sectionCount i acc :
matchBool
(ok (reverse acc) bs)
(bindResult (readSectionRecord bs)
(sectionRecord afterSectionRecord :
self afterSectionRecord sectionCount (succ i) (pair sectionRecord acc)))
(equal? i sectionCount))
readSectionDirectory = (sectionCount bs : readSectionDirectory_ bs sectionCount 0 t)
sectionRecordId = (sectionRecord :
matchPair
(sectionId _ : sectionId)
sectionRecord)
sectionRecordVersion = (sectionRecord :
matchPair
(_ payload :
matchPair
(sectionVersion _ : sectionVersion)
payload)
sectionRecord)
sectionRecordFlags = (sectionRecord :
matchPair
(_ payload :
matchPair
(_ payload2 :
matchPair
(sectionFlags _ : sectionFlags)
payload2)
payload)
sectionRecord)
sectionRecordCompression = (sectionRecord :
matchPair
(_ payload :
matchPair
(_ payload2 :
matchPair
(_ payload3 :
matchPair
(compression _ : compression)
payload3)
payload2)
payload)
sectionRecord)
sectionRecordDigestAlgorithm = (sectionRecord :
matchPair
(_ payload :
matchPair
(_ payload2 :
matchPair
(_ payload3 :
matchPair
(_ payload4 :
matchPair
(digestAlgorithm _ : digestAlgorithm)
payload4)
payload3)
payload2)
payload)
sectionRecord)
sectionRecordOffset = (sectionRecord :
matchPair
(_ payload :
matchPair
(_ payload2 :
matchPair
(_ payload3 :
matchPair
(_ payload4 :
matchPair
(_ payload5 :
matchPair
(offset _ : offset)
payload5)
payload4)
payload3)
payload2)
payload)
sectionRecord)
sectionRecordLength = (sectionRecord :
matchPair
(_ payload :
matchPair
(_ payload2 :
matchPair
(_ payload3 :
matchPair
(_ payload4 :
matchPair
(_ payload5 :
matchPair
(_ payload6 :
matchPair
(length _ : length)
payload6)
payload5)
payload4)
payload3)
payload2)
payload)
sectionRecord)
sectionRecordDigest = (sectionRecord :
matchPair
(_ payload :
matchPair
(_ payload2 :
matchPair
(_ payload3 :
matchPair
(_ payload4 :
matchPair
(_ payload5 :
matchPair
(_ payload6 :
matchPair
(_ digest : digest)
payload6)
payload5)
payload4)
payload3)
payload2)
payload)
sectionRecord)
lookupSectionRecord_ = y (self directory sectionId :
matchList
nothing
(sectionRecord rest :
matchBool
(just sectionRecord)
(self rest sectionId)
(bytesEq? sectionId (sectionRecordId sectionRecord)))
directory)
lookupSectionRecord = (sectionId directory : lookupSectionRecord_ directory sectionId)
sectionDirectoryHasId?_ = y (self directory sectionId :
matchList
false
(sectionRecord rest :
or?
(bytesEq? sectionId (sectionRecordId sectionRecord))
(self rest sectionId))
directory)
sectionDirectoryHasId? = (sectionId directory : sectionDirectoryHasId?_ directory sectionId)
sectionDirectoryHasDuplicateIds? = y (self directory :
matchList
false
(sectionRecord rest :
or?
(sectionDirectoryHasId?_ rest (sectionRecordId sectionRecord))
(self rest))
directory)
validateSectionDirectory = (directory rest :
matchBool
(err errDuplicateSection rest)
(ok directory rest)
(sectionDirectoryHasDuplicateIds? directory))
byteSlice = (offset length bytes : bytesTake length (bytesDrop offset bytes))
natMake = (bit rest :
matchBool
0
(pair bit rest)
(and? (equal? bit 0) (equal? rest 0)))
natAdd = y (self a b :
triage
b
(_ : b)
(aBit aRest :
triage
a
(_ : a)
(bBit bRest :
matchBool
(natMake 0 (succ (self aRest bRest)))
(natMake (matchBool (matchBool 0 1 bBit) (matchBool 1 0 bBit) aBit)
(self aRest bRest))
(and? (equal? aBit 1) (equal? bBit 1)))
b)
a)
natDouble = (n : matchBool 0 (pair 0 n) (equal? n 0))
natTimes256 = (n :
natDouble
(natDouble
(natDouble
(natDouble
(natDouble
(natDouble
(natDouble
(natDouble n))))))))
byteNatShiftAppend_ = y (self byte acc i :
matchBool
acc
(triage
(natMake 0 (self 0 acc (succ i)))
(_ : acc)
(bit rest : natMake bit (self rest acc (succ i)))
byte)
(equal? i 8))
byteNatShiftAppend = (byte acc : byteNatShiftAppend_ byte acc 0)
beBytesToNat = (bytes :
foldl
(acc byte : byteNatShiftAppend byte acc)
0
bytes)
u32BEBytesToNat = beBytesToNat
u64BEBytesToNat = beBytesToNat
arborixHeaderMajorVersion = (header :
matchPair
(majorVersion _ : majorVersion)
header)
arborixHeaderMinorVersion = (header :
matchPair
(_ payload :
matchPair
(minorVersion _ : minorVersion)
payload)
header)
arborixHeaderSectionCount = (header :
matchPair
(_ payload :
matchPair
(_ payload2 :
matchPair
(sectionCount _ : sectionCount)
payload2)
payload)
header)
arborixHeaderFlags = (header :
matchPair
(_ payload :
matchPair
(_ payload2 :
matchPair
(_ payload3 :
matchPair
(flags _ : flags)
payload3)
payload2)
payload)
header)
arborixHeaderDirOffset = (header :
matchPair
(_ payload :
matchPair
(_ payload2 :
matchPair
(_ payload3 :
matchPair
(_ dirOffset : dirOffset)
payload3)
payload2)
payload)
header)
validateArborixHeader = (header rest :
matchBool
(ok header rest)
(err errUnsupportedVersion rest)
(and?
(bytesEq? arborixMajorVersion (arborixHeaderMajorVersion header))
(bytesEq? arborixMinorVersion (arborixHeaderMinorVersion header))))
readArborixContainer = (bs :
bindResult (readArborixHeader bs)
(header afterHeader :
bindResult (validateArborixHeader header afterHeader)
(validHeader afterValidHeader :
bindResult (readSectionDirectory
(u32BEBytesToNat (arborixHeaderSectionCount validHeader))
(bytesDrop (u64BEBytesToNat (arborixHeaderDirOffset validHeader)) bs))
(directory afterDirectory :
bindResult (validateSectionDirectory directory afterDirectory)
(validDirectory afterValidDirectory :
ok (pair validHeader validDirectory) afterValidDirectory)))))
sectionRecordOffsetNat = (sectionRecord :
u64BEBytesToNat (sectionRecordOffset sectionRecord))
sectionRecordLengthNat = (sectionRecord :
u64BEBytesToNat (sectionRecordLength sectionRecord))
extractSectionBytes = (sectionRecord containerBytes :
byteSlice
(sectionRecordOffsetNat sectionRecord)
(sectionRecordLengthNat sectionRecord)
containerBytes)
extractSectionBytesResult = (sectionRecord containerBytes rest :
(sectionBytes :
matchBool
(ok sectionBytes rest)
(err errUnexpectedEof rest)
(equal? (bytesLength sectionBytes) (sectionRecordLengthNat sectionRecord)))
(extractSectionBytes sectionRecord containerBytes))
lookupSectionBytes = (sectionId directory containerBytes :
triage
nothing
(sectionRecord : just (extractSectionBytes sectionRecord containerBytes))
(_ _ : nothing)
(lookupSectionRecord sectionId directory))
sectionBytesOrErr = (sectionId directory containerBytes rest :
triage
(err errMissingSection rest)
(sectionRecord : extractSectionBytesResult sectionRecord containerBytes rest)
(_ _ : err errMissingSection rest)
(lookupSectionRecord sectionId directory))
readArborixSectionBytes = (sectionId bs :
bindResult (readArborixContainer bs)
(container afterContainer :
matchPair
(_ directory : sectionBytesOrErr sectionId directory bs afterContainer)
container))
readArborixRequiredSections = (bs :
bindResult (readArborixContainer bs)
(container afterContainer :
matchPair
(_ directory :
bindResult (sectionBytesOrErr arborixManifestSectionId directory bs afterContainer)
(manifestBytes _ :
bindResult (sectionBytesOrErr arborixNodesSectionId directory bs afterContainer)
(nodesBytes _ :
ok (pair manifestBytes nodesBytes) afterContainer)))
container))
readNodeRecord = (bs :
bindResult (readBytes 32 bs)
(nodeHash afterNodeHash :
bindResult (readBytes 4 afterNodeHash)
(payloadLength afterPayloadLength :
bindResult (readBytes (u32BEBytesToNat payloadLength) afterPayloadLength)
(payload afterPayload :
ok
(pair nodeHash
(pair payloadLength payload))
afterPayload))))
nodeRecordHash = (nodeRecord :
matchPair
(nodeHash _ : nodeHash)
nodeRecord)
nodeRecordPayloadLength = (nodeRecord :
matchPair
(_ payload :
matchPair
(payloadLength _ : payloadLength)
payload)
nodeRecord)
nodeRecordPayload = (nodeRecord :
matchPair
(_ payload :
matchPair
(_ nodePayload : nodePayload)
payload)
nodeRecord)
nodePayloadKind = (nodePayload : bytesHead nodePayload)
nodePayloadHasTag? = (tag nodePayload :
triage
false
(actualTag : byteEq? actualTag tag)
(_ _ : false)
(nodePayloadKind nodePayload))
nodePayloadLeaf? = (nodePayload : bytesEq? [(0)] nodePayload)
nodePayloadStem? = (nodePayload :
and?
(nodePayloadHasTag? nodePayloadStemTag nodePayload)
(equal? (bytesLength nodePayload) 33))
nodePayloadFork? = (nodePayload :
and?
(nodePayloadHasTag? nodePayloadForkTag nodePayload)
(equal? (bytesLength nodePayload) 65))
nodePayloadValid? = (nodePayload :
or?
(nodePayloadLeaf? nodePayload)
(or?
(nodePayloadStem? nodePayload)
(nodePayloadFork? nodePayload)))
nodePayloadStemChildHash = (nodePayload : bytesTake 32 (bytesDrop 1 nodePayload))
nodePayloadForkLeftHash = (nodePayload : bytesTake 32 (bytesDrop 1 nodePayload))
nodePayloadForkRightHash = (nodePayload : bytesTake 32 (bytesDrop 33 nodePayload))
nodeRecordPayloadValid? = (nodeRecord : nodePayloadValid? (nodeRecordPayload nodeRecord))
nodeRecordsHaveInvalidPayload? = y (self nodeRecords :
matchList
false
(nodeRecord rest :
or?
(not? (nodeRecordPayloadValid? nodeRecord))
(self rest))
nodeRecords)
nodeRecordsHaveHash? = y (self nodeRecords nodeHash :
matchList
false
(nodeRecord rest :
or?
(bytesEq? nodeHash (nodeRecordHash nodeRecord))
(self rest nodeHash))
nodeRecords)
nodeRecordsHaveDuplicateHashes? = y (self nodeRecords :
matchList
false
(nodeRecord rest :
or?
(nodeRecordsHaveHash? rest (nodeRecordHash nodeRecord))
(self rest))
nodeRecords)
lookupNodeRecord_ = y (self nodeRecords nodeHash :
matchList
nothing
(nodeRecord rest :
matchBool
(just nodeRecord)
(self rest nodeHash)
(bytesEq? nodeHash (nodeRecordHash nodeRecord)))
nodeRecords)
lookupNodeRecord = (nodeHash nodeRecords : lookupNodeRecord_ nodeRecords nodeHash)
nodeRecordChildHashes = (nodeRecord :
(nodePayload :
matchBool
t
(matchBool
(pair (nodePayloadStemChildHash nodePayload) t)
(pair (nodePayloadForkLeftHash nodePayload)
(pair (nodePayloadForkRightHash nodePayload) t))
(nodePayloadStem? nodePayload))
(nodePayloadLeaf? nodePayload))
(nodeRecordPayload nodeRecord))
nodeHashPresent? = (nodeHash nodeRecords : nodeRecordsHaveHash? nodeRecords nodeHash)
nodeChildHashesPresent? = y (self childHashes nodeRecords :
matchList
true
(childHash rest :
and?
(nodeHashPresent? childHash nodeRecords)
(self rest nodeRecords))
childHashes)
nodeRecordChildrenPresent? = (nodeRecord nodeRecords :
nodeChildHashesPresent? (nodeRecordChildHashes nodeRecord) nodeRecords)
nodeRecordsClosed? = y (self nodeRecords allNodeRecords :
matchList
true
(nodeRecord rest :
and?
(nodeRecordChildrenPresent? nodeRecord allNodeRecords)
(self rest allNodeRecords))
nodeRecords)
validateNodeRecords = (nodeRecords rest :
matchBool
(err errInvalidNodePayload rest)
(matchBool
(err errDuplicateNode rest)
(matchBool
(ok nodeRecords rest)
(err errMissingNode rest)
(nodeRecordsClosed? nodeRecords nodeRecords))
(nodeRecordsHaveDuplicateHashes? nodeRecords))
(nodeRecordsHaveInvalidPayload? nodeRecords))
readNodeRecords_ = y (self bs nodeCount i acc :
matchBool
(ok (reverse acc) bs)
(bindResult (readNodeRecord bs)
(nodeRecord afterNodeRecord :
self afterNodeRecord nodeCount (succ i) (pair nodeRecord acc)))
(equal? i nodeCount))
readNodeRecords = (nodeCount bs : readNodeRecords_ bs nodeCount 0 t)
readNodesSection = (bs :
bindResult (readBytes 8 bs)
(nodeCount afterNodeCount :
bindResult (readNodeRecords (u64BEBytesToNat nodeCount) afterNodeCount)
(nodeRecords afterNodeRecords :
bindResult (validateNodeRecords nodeRecords afterNodeRecords)
(validNodeRecords afterValidNodeRecords :
ok (pair nodeCount validNodeRecords) afterValidNodeRecords))))
readNodesSectionComplete = (bs :
bindResult (readNodesSection bs)
(nodesSection afterNodesSection :
matchBool
(ok nodesSection afterNodesSection)
(err errUnexpectedBytes afterNodesSection)
(bytesNil? afterNodesSection)))
readArborixNodesSection = (bs :
bindResult (readArborixContainer bs)
(container afterContainer :
matchPair
(_ directory :
bindResult (sectionBytesOrErr arborixNodesSectionId directory bs afterContainer)
(nodesBytes _ :
bindResult (readNodesSectionComplete nodesBytes)
(nodesSection _ : ok nodesSection afterContainer)))
container))
nodesSectionCount = (nodesSection :
matchPair
(nodeCount _ : nodeCount)
nodesSection)
nodesSectionRecords = (nodesSection :
matchPair
(_ nodeRecords : nodeRecords)
nodesSection)
nodeRecordToTreeWith = (self nodeRecords nodeRecord :
(nodePayload :
matchBool
(ok t t)
(matchBool
(bindResult (self (nodePayloadStemChildHash nodePayload) nodeRecords)
(child _ : ok (t child) t))
(bindResult (self (nodePayloadForkLeftHash nodePayload) nodeRecords)
(left _ :
bindResult (self (nodePayloadForkRightHash nodePayload) nodeRecords)
(right _ : ok (pair left right) t)))
(nodePayloadStem? nodePayload))
(nodePayloadLeaf? nodePayload))
(nodeRecordPayload nodeRecord))
nodeHashToTree = y (self nodeHash nodeRecords :
triage
(err errMissingNode t)
(nodeRecord : nodeRecordToTreeWith self nodeRecords nodeRecord)
(_ _ : err errMissingNode t)
(lookupNodeRecord nodeHash nodeRecords))
readArborixTreeFromHash = (rootHash bs :
bindResult (readArborixNodesSection bs)
(nodesSection afterContainer :
bindResult (nodeHashToTree rootHash (nodesSectionRecords nodesSection))
(tree _ : ok tree afterContainer)))
readArborixExecutableFromHash = readArborixTreeFromHash

View File

@@ -14,27 +14,29 @@ byteEq? = equal?
bytesLength = length bytesLength = length
bytesAppend = append bytesAppend = append
bytesTake_ = y (self n i remaining : bytesTake_ = y (self remaining n i :
matchBool matchList
t t
(matchList (h r :
t matchBool
(h r : pair h (self n (succ i) r)) t
remaining) (pair h (self r n (succ i)))
(equal? i n)) (equal? i n))
remaining)
bytesTake = n bytes : bytesTake_ n 0 bytes bytesTake = n bytes : bytesTake_ bytes n 0
bytesDrop_ = y (self n i remaining : bytesDrop_ = y (self remaining n i :
matchBool matchList
remaining t
(matchList (_ r :
t matchBool
(_ r : self n (succ i) r) remaining
remaining) (self r n (succ i))
(equal? i n)) (equal? i n))
remaining)
bytesDrop = n bytes : bytesDrop_ n 0 bytes bytesDrop = n bytes : bytesDrop_ bytes n 0
bytesSplitAt = n bytes : pair (bytesTake n bytes) (bytesDrop n bytes) bytesSplitAt = n bytes : pair (bytesTake n bytes) (bytesDrop n bytes)

View File

@@ -27,11 +27,11 @@ filter_ = y (self : matchList
(head tail f : matchBool (t head) id (f head) (self tail f))) (head tail f : matchBool (t head) id (f head) (self tail f)))
filter = f l : filter_ l f filter = f l : filter_ l f
foldl_ = y (self f l x : matchList (acc : acc) (head tail acc : self f tail (f acc head)) l x) foldl_ = y (self l f x : matchList (acc : acc) (head tail acc : self tail f (f acc head)) l x)
foldl = f x l : foldl_ f l x foldl = f x l : foldl_ l f x
foldr_ = y (self x f l : matchList x (head tail : f (self x f tail) head) l) foldr_ = y (self l f x : matchList x (head tail : f (self tail f x) head) l)
foldr = f x l : foldr_ x f l foldr = f x l : foldr_ l f x
length = y (self : matchList length = y (self : matchList
0 0

View File

@@ -1,94 +1,52 @@
# Recursive Consumer Argument Order # Recursive Consumer Argument Order
## Core issue ## Rule
Partial application is generally fine in tricu. The problem appears with recursive consumer functions when loop-control arguments are known before the consumed data is available. Put consumed data first in recursive workers.
The concrete case was `readBytes`. *AVOID* this shape:
This worked: ```text
worker control state input
```tricu
(readBytes 2) [(1) (2) (3)]
``` ```
This used to explode in space: *USE* this shape:
```tricu ```text
readBytes 2 worker input control state
``` ```
At first this looked like a general partial-application problem, but it was not. Other partial applications, such as partially applying `map`, normalized safely. The issue was the argument order and recursive shape of `readBytes_`. The consumed structure should block recursion when it is unknown. Counters, indexes, lengths, and accumulator state should not be able to drive recursion over abstract input.
## What went wrong ## Bad shape
The original worker had loop-control arguments before the byte stream: The original `readBytes_` worker put loop-control arguments before the byte stream:
```tricu ```tricu
readBytes_ = y (self n i bs original acc : ...) readBytes_ = y (self n i bs original acc :
matchBool
(ok (reverse acc) bs)
(matchResult
(code rest : err code original)
(actual rest :
self n (succ i) rest original (pair actual acc))
(readU8 bs))
(equal? i n))
readBytes = (n bs : readBytes_ n 0 bs bs t) readBytes = (n bs : readBytes_ n 0 bs bs t)
``` ```
After partially applying: With a partial application like:
```tricu ```tricu
readBytes 2 readBytes 2
``` ```
the evaluator knew: the evaluator knows `n = 2` and `i = 0`, but `bs` is still abstract. That lets the counter check drive recursive specialization before the byte stream is available, which can build a huge symbolic residual tree. This has been proven; do not reason about it further.
```text ## Good shape
n = 2
i = 0
```
but did not know: The corrected worker takes the byte stream first and immediately case-analyzes it:
```text
bs
original
acc
```
Because the counter values were known, the evaluator could reduce checks like:
```tricu
equal? i n
```
and begin unrolling recursion symbolically before the byte stream existed. That produced a large residual tree describing possible stream cases, rests, and accumulated values.
The bug was not recursion itself. The bug was allowing counters to drive recursion while the consumed structure was still abstract.
## Why `map`-style partial application is safe
A partially-applied list consumer such as:
```tricu
map (i : append i " world!")
```
is safe because recursion is blocked on the missing list argument. The function cannot recurse until it sees whether the list is empty or a cons cell.
Safe shape:
```text
waiting for input
recursion blocked until input is supplied
```
Unsafe shape:
```text
waiting for input
known counters still allow symbolic recursion
```
## Fix
Put the consumed data first in the recursive worker and make the first major operation inspect that data.
Corrected shape:
```tricu ```tricu
readBytes_ = y (self bs n i original acc : readBytes_ = y (self bs n i original acc :
@@ -113,155 +71,11 @@ Now:
readBytes 2 readBytes 2
``` ```
becomes: becomes a function waiting on `bs`. Since the worker immediately performs `matchList ... bs`, evaluation blocks on the missing input instead of unrolling the counter loop.
```tricu ## Takeaway
bs : readBytes_ bs 2 0 bs t
```
Since `bs` is abstract and the worker immediately performs:
```tricu
matchList ... bs
```
evaluation blocks at the data boundary instead of unrolling the counter loop.
## General rule
For recursive consumers, the consumed structure should drive evaluation.
Prefer:
```tricu
worker = y (self input control state :
matchInput
baseCase
(piece rest : ... self rest control nextState ...)
input)
```
Avoid:
```tricu
worker = y (self control state input :
if controlDone
done
(... self nextControl nextState rest ...))
```
In practice:
```text ```text
worker input control state Let consumed data drive recursion.
```
is safer than:
```text
worker control state input
```
## Accumulators
Be careful not to finalize or transform an abstract accumulator too early.
For example:
```tricu
ok (reverse acc) bs
```
is fine when reached after concrete input has driven the recursion, but it can become pathological if reached while `acc` is still abstract.
Guidelines:
- Accumulate cheaply during recursion.
- Finalize, reverse, or validate only after input has forced the function to a concrete success point.
- Do not let counters select a success branch while the accumulator is still abstract.
## Parser guidance
For byte or parser consumers, prefer streaming over global slicing of unknown input.
Prefer:
```tricu
read one byte
compare or accumulate
recurse on rest
```
Avoid relying on:
```tricu
taken = bytesTake n bs
rest = bytesDrop n bs
enough = bytesLength taken == n
```
The slice-based version may be correct on concrete input but can behave badly when partially applied over abstract input.
Streaming alone is not enough; the recursive worker must also be data-first.
## Checklist
When writing a recursive consumer, ask:
1. What structure is consumed?
2. What argument should block recursion when unknown?
3. Are counters available before the consumed structure?
4. Could partial application specialize the loop before data arrives?
5. Does any branch process an abstract accumulator or rest value?
6. Does the worker put consumed data before counters and state?
## Safe and unsafe examples
Safe:
```tricu
readU8
bs : readU8 bs
readBytes 2 [(1) (2) (3)]
(readBytes 2) [(1) (2) (3)]
map (i : append i " world!")
```
Previously unsafe before the data-first rewrite:
```tricu
readBytes 2
readBytes_ 2 0
```
## Implication for Arborix
Arborix parsers will include many recursive consumers:
- read N bytes
- read N section records
- scan records for an ID
- parse node records
- validate closures
These should use data-first recursive workers.
Avoid:
```tricu
readSectionRecords_ count index bs acc
```
Prefer:
```tricu
readSectionRecords_ bs count index acc
```
## Short rule
```text
Put consumed data first in recursive workers.
Let data shape drive recursion.
Do not let counters unroll over abstract input. Do not let counters unroll over abstract input.
``` ```

View File

@@ -223,6 +223,9 @@ freeVars (SVar v Nothing) = Set.singleton v
freeVars (SVar v (Just _)) = Set.singleton v freeVars (SVar v (Just _)) = Set.singleton v
freeVars (SApp t u) = Set.union (freeVars t) (freeVars u) freeVars (SApp t u) = Set.union (freeVars t) (freeVars u)
freeVars (SLambda vs body) = Set.difference (freeVars body) (Set.fromList vs) freeVars (SLambda vs body) = Set.difference (freeVars body) (Set.fromList vs)
freeVars (TStem t) = freeVars t
freeVars (TFork t u) = Set.union (freeVars t) (freeVars u)
freeVars (SList xs) = foldMap freeVars xs
freeVars _ = Set.empty freeVars _ = Set.empty
reorderDefs :: Env -> [TricuAST] -> [TricuAST] reorderDefs :: Env -> [TricuAST] -> [TricuAST]
@@ -394,12 +397,10 @@ toSKIDB t
| not (dependsOnLevel 0 t) = SApp _K (fromDBClosed t) | not (dependsOnLevel 0 t) = SApp _K (fromDBClosed t)
toSKIDB (BVar 0) = _I toSKIDB (BVar 0) = _I
toSKIDB (BApp n u) = SApp (SApp _S (toSKIDB n)) (toSKIDB u) toSKIDB (BApp n u) = SApp (SApp _S (toSKIDB n)) (toSKIDB u)
toSKIDB (BList xs) = toSKIDB (BStem t) = toSKIDB (BApp BLeaf t)
let anyUses = any (dependsOnLevel 0) xs toSKIDB (BFork l r) = toSKIDB (BApp (BApp BLeaf l) r)
in if not anyUses toSKIDB (BList xs) = toSKIDB (foldr (\m r -> BApp (BApp BLeaf m) r) BLeaf xs)
then SApp _K (SList (map fromDBClosed xs)) toSKIDB other = error $ "toSKIDB: unsupported DB term: " ++ show other
else SList (map toSKIDB xs)
toSKIDB _other = _K `SApp` TLeaf
app2 :: TricuAST -> TricuAST -> TricuAST app2 :: TricuAST -> TricuAST -> TricuAST
app2 f x = SApp f x app2 f x = SApp f x

View File

@@ -12,6 +12,7 @@ import ContentStore
import Control.Exception (evaluate, try, SomeException) import Control.Exception (evaluate, try, SomeException)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import Data.Bits (xor) import Data.Bits (xor)
import Data.Char (digitToInt)
import Data.List (isInfixOf) import Data.List (isInfixOf)
import Data.Text (Text, unpack) import Data.Text (Text, unpack)
import Data.Word (Word8) import Data.Word (Word8)
@@ -1051,6 +1052,104 @@ byteT = ofNumber
bytesT :: [Integer] -> T bytesT :: [Integer] -> T
bytesT = ofList . fmap byteT bytesT = ofList . fmap byteT
bytesExpr :: [Integer] -> String
bytesExpr xs = "[" ++ unwords (map (\n -> "(" ++ show n ++ ")") xs) ++ "]"
u16 :: Integer -> [Integer]
u16 n = [0,n]
u32 :: Integer -> [Integer]
u32 n = [0,0,0,n]
u64 :: Integer -> [Integer]
u64 n = [0,0,0,0,0,0,0,n]
arborixHeaderBytes :: Integer -> [Integer]
arborixHeaderBytes sectionCount =
[65,82,66,79,82,73,88,0]
++ u16 1
++ u16 0
++ u32 sectionCount
++ u64 0
++ u64 32
sectionEntryBytes :: [Integer] -> Integer -> Integer -> [Integer]
sectionEntryBytes sectionType offset lengthBytes =
sectionType
++ u16 1
++ u16 1
++ u16 0
++ u16 1
++ u64 offset
++ u64 lengthBytes
++ replicate 32 0
manifestSectionIdBytes :: [Integer]
manifestSectionIdBytes = [0,0,0,1]
nodesSectionIdBytes :: [Integer]
nodesSectionIdBytes = [0,0,0,2]
hexTextBytes :: Text -> [Integer]
hexTextBytes h = go (unpack h)
where
go [] = []
go (a:b:rest) = toInteger (digitToInt a * 16 + digitToInt b) : go rest
go _ = error "odd-length hex text"
manifestEntryBytes :: Integer -> Integer -> [Integer]
manifestEntryBytes = sectionEntryBytes manifestSectionIdBytes
nodesEntryBytes :: Integer -> Integer -> [Integer]
nodesEntryBytes = sectionEntryBytes nodesSectionIdBytes
simpleContainerBytes :: [Integer] -> [Integer] -> [Integer]
simpleContainerBytes manifestBytes nodesBytes =
let manifestOffset = 152
nodesOffset = manifestOffset + fromIntegral (length manifestBytes)
in arborixHeaderBytes 2
++ manifestEntryBytes manifestOffset (fromIntegral $ length manifestBytes)
++ nodesEntryBytes nodesOffset (fromIntegral $ length nodesBytes)
++ manifestBytes
++ nodesBytes
singleSectionContainerBytes :: [Integer] -> [Integer] -> [Integer]
singleSectionContainerBytes sectionType sectionBytes =
arborixHeaderBytes 1
++ sectionEntryBytes sectionType 92 (fromIntegral $ length sectionBytes)
++ sectionBytes
arborixHeaderT :: Integer -> T
arborixHeaderT sectionCount =
pairT (bytesT [0,1])
(pairT (bytesT [0,0])
(pairT (bytesT $ u32 sectionCount)
(pairT (bytesT $ u64 0)
(bytesT $ u64 32))))
sectionRecordT :: [Integer] -> Integer -> Integer -> T
sectionRecordT sectionType offset lengthBytes =
pairT (bytesT sectionType)
(pairT (bytesT [0,1])
(pairT (bytesT [0,1])
(pairT (bytesT [0,0])
(pairT (bytesT [0,1])
(pairT (bytesT $ u64 offset)
(pairT (bytesT $ u64 lengthBytes)
(bytesT $ replicate 32 0)))))))
sectionRecordExpr :: [Integer] -> Integer -> Integer -> String
sectionRecordExpr sectionType offset lengthBytes =
"(pair " ++ bytesExpr sectionType
++ " (pair " ++ bytesExpr [0,1]
++ " (pair " ++ bytesExpr [0,1]
++ " (pair " ++ bytesExpr [0,0]
++ " (pair " ++ bytesExpr [0,1]
++ " (pair " ++ bytesExpr (u64 offset)
++ " (pair " ++ bytesExpr (u64 lengthBytes)
++ " " ++ bytesExpr (replicate 32 0)
++ ")))))))"
byteListUtilities :: TestTree byteListUtilities :: TestTree
byteListUtilities = testGroup "Byte List Utility Tests" byteListUtilities = testGroup "Byte List Utility Tests"
[ testCase "isNil: empty list is nil" $ do [ testCase "isNil: empty list is nil" $ do
@@ -1249,6 +1348,24 @@ unexpectedBytesT = byteT 2
unexpectedByteT :: T unexpectedByteT :: T
unexpectedByteT = byteT 3 unexpectedByteT = byteT 3
missingSectionT :: T
missingSectionT = byteT 4
unsupportedVersionT :: T
unsupportedVersionT = byteT 5
duplicateSectionT :: T
duplicateSectionT = byteT 6
duplicateNodeT :: T
duplicateNodeT = byteT 7
invalidNodePayloadT :: T
invalidNodePayloadT = byteT 8
missingNodeT :: T
missingNodeT = byteT 9
binaryReaderTests :: TestTree binaryReaderTests :: TestTree
binaryReaderTests = testGroup "Binary Reader Tests" binaryReaderTests = testGroup "Binary Reader Tests"
[ testCase "readU8: empty input returns err" $ do [ testCase "readU8: empty input returns err" $ do
@@ -1523,25 +1640,17 @@ binaryReaderTests = testGroup "Binary Reader Tests"
-- Arborix header parsing -- Arborix header parsing
-- ------------------------------------------------------------------------ -- ------------------------------------------------------------------------
, testCase "readArborixHeader: parses version and section count" $ do , testCase "readArborixHeader: parses portable header" $ do
let input = "readArborixHeader [(65) (82) (66) (79) (82) (73) (88) (0) (0) (1) (0) (0) (0) (0) (0) (0)]" let input = "readArborixHeader " ++ bytesExpr (arborixHeaderBytes 0)
library <- evaluateFile "./lib/arborix.tri" library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input) let env = evalTricu library (parseTricu input)
result env @?= okT result env @?= okT (arborixHeaderT 0) (bytesT [])
(pairT (bytesT [0,1])
(pairT (bytesT [0,0])
(bytesT [0,0,0,0])))
(bytesT [])
, testCase "readArborixHeader: preserves trailing bytes" $ do , testCase "readArborixHeader: preserves trailing bytes" $ do
let input = "readArborixHeader [(65) (82) (66) (79) (82) (73) (88) (0) (0) (1) (0) (0) (0) (0) (0) (0) (9) (8)]" let input = "readArborixHeader " ++ bytesExpr (arborixHeaderBytes 0 ++ [9,8])
library <- evaluateFile "./lib/arborix.tri" library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input) let env = evalTricu library (parseTricu input)
result env @?= okT result env @?= okT (arborixHeaderT 0) (bytesT [9,8])
(pairT (bytesT [0,1])
(pairT (bytesT [0,0])
(bytesT [0,0,0,0])))
(bytesT [9,8])
, testCase "readArborixHeader: rejects wrong magic preserving input" $ do , testCase "readArborixHeader: rejects wrong magic preserving input" $ do
let input = "readArborixHeader [(65) (82) (66) (79) (82) (73) (88) (1) (0) (1)]" let input = "readArborixHeader [(65) (82) (66) (79) (82) (73) (88) (1) (0) (1)]"
@@ -1554,4 +1663,528 @@ binaryReaderTests = testGroup "Binary Reader Tests"
library <- evaluateFile "./lib/arborix.tri" library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input) let env = evalTricu library (parseTricu input)
result env @?= errT eofT (bytesT [65,82]) result env @?= errT eofT (bytesT [65,82])
-- ------------------------------------------------------------------------
-- Arborix section directory record parsing
-- ------------------------------------------------------------------------
, testCase "readSectionRecord: parses portable section entry" $ do
let input = "readSectionRecord " ++ bytesExpr (nodesEntryBytes 16 32)
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= okT (sectionRecordT nodesSectionIdBytes 16 32) (bytesT [])
, testCase "readSectionRecord: preserves trailing bytes" $ do
let input = "readSectionRecord " ++ bytesExpr (nodesEntryBytes 16 32 ++ [9,8])
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= okT (sectionRecordT nodesSectionIdBytes 16 32) (bytesT [9,8])
, testCase "readSectionRecord: empty input returns EOF" $ do
let input = "readSectionRecord []"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= errT eofT (bytesT [])
, testCase "readSectionRecord: short section id returns EOF preserving input" $ do
let input = "readSectionRecord [(0)]"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= errT eofT (bytesT [0])
, testCase "readSectionRecord: missing section version returns EOF preserving unread bytes" $ do
let input = "readSectionRecord [(0) (2)]"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= errT eofT (bytesT [0,2])
, testCase "readSectionRecord: short section version returns EOF preserving unread bytes" $ do
let input = "readSectionRecord [(0) (2) (0) (0) (0)]"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= errT eofT (bytesT [0])
, testCase "readSectionRecord: missing length returns EOF preserving unread length bytes" $ do
let input = "readSectionRecord [(0) (2) (0) (0) (0) (16)]"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= errT eofT (bytesT [])
, testCase "readSectionRecord: short section flags returns EOF preserving unread bytes" $ do
let input = "readSectionRecord [(0) (2) (0) (0) (0) (16) (0) (0) (0)]"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= errT eofT (bytesT [0])
-- ------------------------------------------------------------------------
-- Arborix section directory parsing
-- ------------------------------------------------------------------------
, testCase "readSectionDirectory: zero records preserves input" $ do
let input = "readSectionDirectory 0 [(9) (8)]"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= okT (ofList []) (bytesT [9,8])
, testCase "readSectionDirectory: reads requested records and preserves trailing bytes" $ do
let input = "readSectionDirectory 2 " ++ bytesExpr (manifestEntryBytes 10 20 ++ nodesEntryBytes 30 40 ++ [9])
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= okT
(ofList
[ sectionRecordT manifestSectionIdBytes 10 20
, sectionRecordT nodesSectionIdBytes 30 40
])
(bytesT [9])
, testCase "readSectionDirectory: truncated record returns EOF" $ do
let input = "readSectionDirectory 2 [(0) (1) (0) (0) (0) (10) (0) (0) (0) (20) (0) (2) (0) (0)]"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= errT eofT (bytesT [0,0])
-- ------------------------------------------------------------------------
-- Arborix section lookup and raw byte slicing
-- ------------------------------------------------------------------------
, testCase "lookupSectionRecord: finds record by raw section id" $ do
let input = "lookupSectionRecord " ++ bytesExpr nodesSectionIdBytes ++ " [(" ++ "pair " ++ bytesExpr manifestSectionIdBytes ++ " (pair " ++ bytesExpr [0,1] ++ " (pair " ++ bytesExpr [0,1] ++ " (pair " ++ bytesExpr [0,0] ++ " (pair " ++ bytesExpr [0,1] ++ " (pair " ++ bytesExpr (u64 10) ++ " (pair " ++ bytesExpr (u64 20) ++ " " ++ bytesExpr (replicate 32 0) ++ "))))))" ++ ") (" ++ "pair " ++ bytesExpr nodesSectionIdBytes ++ " (pair " ++ bytesExpr [0,1] ++ " (pair " ++ bytesExpr [0,1] ++ " (pair " ++ bytesExpr [0,0] ++ " (pair " ++ bytesExpr [0,1] ++ " (pair " ++ bytesExpr (u64 30) ++ " (pair " ++ bytesExpr (u64 40) ++ " " ++ bytesExpr (replicate 32 0) ++ "))))))" ++ ")]"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= justT (sectionRecordT nodesSectionIdBytes 30 40)
, testCase "lookupSectionRecord: missing section id returns nothing" $ do
let input = "lookupSectionRecord " ++ bytesExpr [0,0,0,3] ++ " [(" ++ "pair " ++ bytesExpr manifestSectionIdBytes ++ " (pair " ++ bytesExpr [0,1] ++ " (pair " ++ bytesExpr [0,1] ++ " (pair " ++ bytesExpr [0,0] ++ " (pair " ++ bytesExpr [0,1] ++ " (pair " ++ bytesExpr (u64 10) ++ " (pair " ++ bytesExpr (u64 20) ++ " " ++ bytesExpr (replicate 32 0) ++ "))))))" ++ ") (" ++ "pair " ++ bytesExpr nodesSectionIdBytes ++ " (pair " ++ bytesExpr [0,1] ++ " (pair " ++ bytesExpr [0,1] ++ " (pair " ++ bytesExpr [0,0] ++ " (pair " ++ bytesExpr [0,1] ++ " (pair " ++ bytesExpr (u64 30) ++ " (pair " ++ bytesExpr (u64 40) ++ " " ++ bytesExpr (replicate 32 0) ++ "))))))" ++ ")]"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= nothingT
, testCase "byteSlice: extracts requested byte range" $ do
let input = "byteSlice 2 3 [(10) (11) (12) (13) (14) (15)]"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= bytesT [12,13,14]
, testCase "byteSlice: overlong length returns remaining bytes" $ do
let input = "byteSlice 4 9 [(10) (11) (12) (13) (14) (15)]"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= bytesT [14,15]
-- ------------------------------------------------------------------------
-- Arborix minimal container parsing foundation
-- ------------------------------------------------------------------------
, testCase "u32BEBytesToNat: decodes zero" $ do
let input = "u32BEBytesToNat [(0) (0) (0) (0)]"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= ofNumber 0
, testCase "u32BEBytesToNat: decodes small section count" $ do
let input = "u32BEBytesToNat [(0) (0) (0) (2)]"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= ofNumber 2
, testCase "u64BEBytesToNat: decodes small node count" $ do
let input = "u64BEBytesToNat [(0) (0) (0) (0) (0) (0) (0) (2)]"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= ofNumber 2
, testCase "u64BEBytesToNat: decodes fixture-scale offset" $ do
let input = "u64BEBytesToNat [(0) (0) (0) (0) (0) (0) (3) (214)]"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= ofNumber 982
, testCase "readArborixContainer: reads header directory and preserves payload" $ do
let input = "readArborixContainer " ++ bytesExpr (simpleContainerBytes [101,102,103] [201,202,203,204])
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= okT
(pairT
(arborixHeaderT 2)
(ofList
[ sectionRecordT manifestSectionIdBytes 152 3
, sectionRecordT nodesSectionIdBytes 155 4
]))
(bytesT [101,102,103,201,202,203,204])
, testCase "readArborixContainer: truncated directory returns EOF" $ do
let input = "readArborixContainer " ++ bytesExpr (arborixHeaderBytes 1 ++ [0,0])
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= errT eofT (bytesT [0,0])
, testCase "readArborixContainer: rejects unsupported major version" $ do
let badHeader = [65,82,66,79,82,73,88,0] ++ u16 2 ++ u16 0 ++ u32 0 ++ u64 0 ++ u64 32
input = "readArborixContainer " ++ bytesExpr badHeader
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= errT unsupportedVersionT (bytesT [])
, testCase "readArborixContainer: rejects unsupported minor version" $ do
let badHeader = [65,82,66,79,82,73,88,0] ++ u16 1 ++ u16 1 ++ u32 0 ++ u64 0 ++ u64 32
input = "readArborixContainer " ++ bytesExpr badHeader
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= errT unsupportedVersionT (bytesT [])
, testCase "readArborixContainer: rejects duplicate section ids" $ do
let input = "readArborixContainer " ++ bytesExpr (arborixHeaderBytes 2 ++ manifestEntryBytes 152 1 ++ manifestEntryBytes 153 1 ++ [9])
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= errT duplicateSectionT (bytesT [9])
, testCase "extractSectionBytes: uses raw offset and length fields" $ do
let input = "extractSectionBytes " ++ sectionRecordExpr nodesSectionIdBytes 3 4 ++ " " ++ bytesExpr [10,11,12,13,14,15,16,17]
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= bytesT [13,14,15,16]
, testCase "lookupSectionBytes: finds section and extracts raw bytes" $ do
let input = "lookupSectionBytes " ++ bytesExpr nodesSectionIdBytes ++ " [" ++ sectionRecordExpr manifestSectionIdBytes 1 2 ++ " " ++ sectionRecordExpr nodesSectionIdBytes 4 3 ++ "] " ++ bytesExpr [10,11,12,13,14,15,16,17]
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= justT (bytesT [14,15,16])
, testCase "lookupSectionBytes: missing section returns nothing" $ do
let input = "lookupSectionBytes " ++ bytesExpr [0,0,0,3] ++ " [" ++ sectionRecordExpr manifestSectionIdBytes 1 2 ++ " " ++ sectionRecordExpr nodesSectionIdBytes 4 3 ++ "] " ++ bytesExpr [10,11,12,13,14,15,16,17]
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= nothingT
, testCase "extractSectionBytesResult: rejects out-of-bounds section" $ do
let input = "extractSectionBytesResult " ++ sectionRecordExpr nodesSectionIdBytes 6 4 ++ " " ++ bytesExpr [10,11,12,13,14,15,16,17] ++ " []"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= errT eofT (bytesT [])
, testCase "readArborixSectionBytes: extracts requested section from container" $ do
let input = "readArborixSectionBytes " ++ bytesExpr nodesSectionIdBytes ++ " " ++ bytesExpr (simpleContainerBytes [101,102,103] [201,202,203,204])
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= okT (bytesT [201,202,203,204]) (bytesT [101,102,103,201,202,203,204])
, testCase "readArborixSectionBytes: missing section returns missing-section err" $ do
let input = "readArborixSectionBytes " ++ bytesExpr nodesSectionIdBytes ++ " " ++ bytesExpr (singleSectionContainerBytes manifestSectionIdBytes [101,102,103])
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= errT missingSectionT (bytesT [101,102,103])
, testCase "readArborixRequiredSections: extracts manifest and nodes bytes" $ do
let input = "readArborixRequiredSections " ++ bytesExpr (simpleContainerBytes [101,102,103] [201,202,203,204])
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= okT
(pairT (bytesT [101,102,103]) (bytesT [201,202,203,204]))
(bytesT [101,102,103,201,202,203,204])
, testCase "readArborixRequiredSections: missing nodes section returns missing-section err" $ do
let input = "readArborixRequiredSections " ++ bytesExpr (singleSectionContainerBytes manifestSectionIdBytes [101,102,103])
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= errT missingSectionT (bytesT [101,102,103])
, testCase "readArborixRequiredSections: out-of-bounds section returns EOF" $ do
let manifestBytes = [101,102,103]
nodesBytes = [201,202,203,204]
badContainer = arborixHeaderBytes 2 ++ manifestEntryBytes 152 3 ++ nodesEntryBytes 155 9 ++ manifestBytes ++ nodesBytes
input = "readArborixRequiredSections " ++ bytesExpr badContainer
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= errT eofT (bytesT [101,102,103,201,202,203,204])
-- ------------------------------------------------------------------------
-- Arborix raw nodes section parsing
-- ------------------------------------------------------------------------
, testCase "readNodeRecord: parses hash length and raw payload" $ do
let input = "readNodeRecord [(1) (2) (3) (4) (5) (6) (7) (8) (9) (10) (11) (12) (13) (14) (15) (16) (17) (18) (19) (20) (21) (22) (23) (24) (25) (26) (27) (28) (29) (30) (31) (32) (0) (0) (0) (3) (101) (102) (103) (9)]"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= okT
(pairT (bytesT [1..32])
(pairT (bytesT [0,0,0,3])
(bytesT [101,102,103])))
(bytesT [9])
, testCase "readNodeRecord: truncated payload returns EOF preserving unread payload" $ do
let input = "readNodeRecord [(1) (2) (3) (4) (5) (6) (7) (8) (9) (10) (11) (12) (13) (14) (15) (16) (17) (18) (19) (20) (21) (22) (23) (24) (25) (26) (27) (28) (29) (30) (31) (32) (0) (0) (0) (3) (101) (102)]"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= errT eofT (bytesT [101,102])
, testCase "readNodesSection: parses node count and records" $ do
let input = "readNodesSection [(0) (0) (0) (0) (0) (0) (0) (1) (1) (2) (3) (4) (5) (6) (7) (8) (9) (10) (11) (12) (13) (14) (15) (16) (17) (18) (19) (20) (21) (22) (23) (24) (25) (26) (27) (28) (29) (30) (31) (32) (0) (0) (0) (1) (0) (9)]"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= okT
(pairT (bytesT [0,0,0,0,0,0,0,1])
(ofList
[ pairT (bytesT [1..32])
(pairT (bytesT [0,0,0,1])
(bytesT [0]))
]))
(bytesT [9])
, testCase "readNodesSectionComplete: rejects trailing bytes inside nodes section" $ do
let input = "readNodesSectionComplete [(0) (0) (0) (0) (0) (0) (0) (0) (9)]"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= errT unexpectedBytesT (bytesT [9])
, testCase "readNodesSection: rejects duplicate node hashes" $ do
let input = "readNodesSection [(0) (0) (0) (0) (0) (0) (0) (2) (1) (2) (3) (4) (5) (6) (7) (8) (9) (10) (11) (12) (13) (14) (15) (16) (17) (18) (19) (20) (21) (22) (23) (24) (25) (26) (27) (28) (29) (30) (31) (32) (0) (0) (0) (1) (0) (1) (2) (3) (4) (5) (6) (7) (8) (9) (10) (11) (12) (13) (14) (15) (16) (17) (18) (19) (20) (21) (22) (23) (24) (25) (26) (27) (28) (29) (30) (31) (32) (0) (0) (0) (1) (0) (9)]"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= errT duplicateNodeT (bytesT [9])
, testCase "nodePayloadValid?: accepts leaf stem and fork payload shapes" $ do
let input = "[(nodePayloadValid? [(0)]) (nodePayloadValid? [(1) (1) (2) (3) (4) (5) (6) (7) (8) (9) (10) (11) (12) (13) (14) (15) (16) (17) (18) (19) (20) (21) (22) (23) (24) (25) (26) (27) (28) (29) (30) (31) (32)]) (nodePayloadValid? [(2) (1) (2) (3) (4) (5) (6) (7) (8) (9) (10) (11) (12) (13) (14) (15) (16) (17) (18) (19) (20) (21) (22) (23) (24) (25) (26) (27) (28) (29) (30) (31) (32) (33) (34) (35) (36) (37) (38) (39) (40) (41) (42) (43) (44) (45) (46) (47) (48) (49) (50) (51) (52) (53) (54) (55) (56) (57) (58) (59) (60) (61) (62) (63) (64)])]"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= ofList [trueT, trueT, trueT]
, testCase "nodePayloadValid?: rejects invalid payload shapes" $ do
let input = "[(nodePayloadValid? []) (nodePayloadValid? [(9)]) (nodePayloadValid? [(1) (1)]) (nodePayloadValid? [(2) (1) (2)])]"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= ofList [falseT, falseT, falseT, falseT]
, testCase "node payload child accessors expose raw hashes" $ do
let input = "[(nodePayloadStemChildHash [(1) (1) (2) (3) (4) (5) (6) (7) (8) (9) (10) (11) (12) (13) (14) (15) (16) (17) (18) (19) (20) (21) (22) (23) (24) (25) (26) (27) (28) (29) (30) (31) (32)]) (nodePayloadForkLeftHash [(2) (1) (2) (3) (4) (5) (6) (7) (8) (9) (10) (11) (12) (13) (14) (15) (16) (17) (18) (19) (20) (21) (22) (23) (24) (25) (26) (27) (28) (29) (30) (31) (32) (33) (34) (35) (36) (37) (38) (39) (40) (41) (42) (43) (44) (45) (46) (47) (48) (49) (50) (51) (52) (53) (54) (55) (56) (57) (58) (59) (60) (61) (62) (63) (64)]) (nodePayloadForkRightHash [(2) (1) (2) (3) (4) (5) (6) (7) (8) (9) (10) (11) (12) (13) (14) (15) (16) (17) (18) (19) (20) (21) (22) (23) (24) (25) (26) (27) (28) (29) (30) (31) (32) (33) (34) (35) (36) (37) (38) (39) (40) (41) (42) (43) (44) (45) (46) (47) (48) (49) (50) (51) (52) (53) (54) (55) (56) (57) (58) (59) (60) (61) (62) (63) (64)])]"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= ofList [bytesT [1..32], bytesT [1..32], bytesT [33..64]]
, testCase "lookupNodeRecord: finds record by raw node hash" $ do
let input = "lookupNodeRecord [(33) (34) (35) (36) (37) (38) (39) (40) (41) (42) (43) (44) (45) (46) (47) (48) (49) (50) (51) (52) (53) (54) (55) (56) (57) (58) (59) (60) (61) (62) (63) (64)] [(pair [(1) (2) (3) (4) (5) (6) (7) (8) (9) (10) (11) (12) (13) (14) (15) (16) (17) (18) (19) (20) (21) (22) (23) (24) (25) (26) (27) (28) (29) (30) (31) (32)] (pair [(0) (0) (0) (1)] [(0)])) (pair [(33) (34) (35) (36) (37) (38) (39) (40) (41) (42) (43) (44) (45) (46) (47) (48) (49) (50) (51) (52) (53) (54) (55) (56) (57) (58) (59) (60) (61) (62) (63) (64)] (pair [(0) (0) (0) (1)] [(0)]))]"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= justT
(pairT (bytesT [33..64])
(pairT (bytesT [0,0,0,1])
(bytesT [0])))
, testCase "nodeRecordChildHashes: extracts stem and fork references" $ do
let input = "[(nodeRecordChildHashes (pair [(1) (2) (3) (4) (5) (6) (7) (8) (9) (10) (11) (12) (13) (14) (15) (16) (17) (18) (19) (20) (21) (22) (23) (24) (25) (26) (27) (28) (29) (30) (31) (32)] (pair [(0) (0) (0) (33)] [(1) (33) (34) (35) (36) (37) (38) (39) (40) (41) (42) (43) (44) (45) (46) (47) (48) (49) (50) (51) (52) (53) (54) (55) (56) (57) (58) (59) (60) (61) (62) (63) (64)]))) (nodeRecordChildHashes (pair [(1) (2) (3) (4) (5) (6) (7) (8) (9) (10) (11) (12) (13) (14) (15) (16) (17) (18) (19) (20) (21) (22) (23) (24) (25) (26) (27) (28) (29) (30) (31) (32)] (pair [(0) (0) (0) (65)] [(2) (33) (34) (35) (36) (37) (38) (39) (40) (41) (42) (43) (44) (45) (46) (47) (48) (49) (50) (51) (52) (53) (54) (55) (56) (57) (58) (59) (60) (61) (62) (63) (64) (65) (66) (67) (68) (69) (70) (71) (72) (73) (74) (75) (76) (77) (78) (79) (80) (81) (82) (83) (84) (85) (86) (87) (88) (89) (90) (91) (92) (93) (94) (95) (96)])))]"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= ofList
[ ofList [bytesT [33..64]]
, ofList [bytesT [33..64], bytesT [65..96]]
]
, testCase "readNodesSection: rejects invalid node payload shape" $ do
let input = "readNodesSection [(0) (0) (0) (0) (0) (0) (0) (1) (1) (2) (3) (4) (5) (6) (7) (8) (9) (10) (11) (12) (13) (14) (15) (16) (17) (18) (19) (20) (21) (22) (23) (24) (25) (26) (27) (28) (29) (30) (31) (32) (0) (0) (0) (1) (9)]"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= errT invalidNodePayloadT (bytesT [])
, testCase "readNodesSection: rejects missing child node" $ do
let input = "readNodesSection [(0) (0) (0) (0) (0) (0) (0) (1) (1) (2) (3) (4) (5) (6) (7) (8) (9) (10) (11) (12) (13) (14) (15) (16) (17) (18) (19) (20) (21) (22) (23) (24) (25) (26) (27) (28) (29) (30) (31) (32) (0) (0) (0) (33) (1) (33) (34) (35) (36) (37) (38) (39) (40) (41) (42) (43) (44) (45) (46) (47) (48) (49) (50) (51) (52) (53) (54) (55) (56) (57) (58) (59) (60) (61) (62) (63) (64) (9)]"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= errT missingNodeT (bytesT [9])
, testCase "readArborixNodesSection: extracts and parses raw nodes section" $ do
let nodesBytes = u64 1 ++ [1..32] ++ u32 1 ++ [0]
input = "readArborixNodesSection " ++ bytesExpr (simpleContainerBytes [101,102,103] nodesBytes)
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= okT
(pairT (bytesT [0,0,0,0,0,0,0,1])
(ofList
[ pairT (bytesT [1..32])
(pairT (bytesT [0,0,0,1])
(bytesT [0]))
]))
(bytesT ([101,102,103] ++ nodesBytes))
-- ------------------------------------------------------------------------
-- Arborix node DAG reconstruction
-- ------------------------------------------------------------------------
, testCase "nodeHashToTree: reconstructs leaf node" $ do
let input = "nodeHashToTree [(1) (2) (3) (4) (5) (6) (7) (8) (9) (10) (11) (12) (13) (14) (15) (16) (17) (18) (19) (20) (21) (22) (23) (24) (25) (26) (27) (28) (29) (30) (31) (32)] [(pair [(1) (2) (3) (4) (5) (6) (7) (8) (9) (10) (11) (12) (13) (14) (15) (16) (17) (18) (19) (20) (21) (22) (23) (24) (25) (26) (27) (28) (29) (30) (31) (32)] (pair [(0) (0) (0) (1)] [(0)]))]"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= okT Leaf Leaf
, testCase "nodeHashToTree: reconstructs stem node" $ do
let input = "nodeHashToTree [(33) (34) (35) (36) (37) (38) (39) (40) (41) (42) (43) (44) (45) (46) (47) (48) (49) (50) (51) (52) (53) (54) (55) (56) (57) (58) (59) (60) (61) (62) (63) (64)] [(pair [(1) (2) (3) (4) (5) (6) (7) (8) (9) (10) (11) (12) (13) (14) (15) (16) (17) (18) (19) (20) (21) (22) (23) (24) (25) (26) (27) (28) (29) (30) (31) (32)] (pair [(0) (0) (0) (1)] [(0)])) (pair [(33) (34) (35) (36) (37) (38) (39) (40) (41) (42) (43) (44) (45) (46) (47) (48) (49) (50) (51) (52) (53) (54) (55) (56) (57) (58) (59) (60) (61) (62) (63) (64)] (pair [(0) (0) (0) (33)] [(1) (1) (2) (3) (4) (5) (6) (7) (8) (9) (10) (11) (12) (13) (14) (15) (16) (17) (18) (19) (20) (21) (22) (23) (24) (25) (26) (27) (28) (29) (30) (31) (32)]))]"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= okT (Stem Leaf) Leaf
, testCase "nodeHashToTree: reconstructs fork node" $ do
let input = "nodeHashToTree [(65) (66) (67) (68) (69) (70) (71) (72) (73) (74) (75) (76) (77) (78) (79) (80) (81) (82) (83) (84) (85) (86) (87) (88) (89) (90) (91) (92) (93) (94) (95) (96)] [(pair [(1) (2) (3) (4) (5) (6) (7) (8) (9) (10) (11) (12) (13) (14) (15) (16) (17) (18) (19) (20) (21) (22) (23) (24) (25) (26) (27) (28) (29) (30) (31) (32)] (pair [(0) (0) (0) (1)] [(0)])) (pair [(33) (34) (35) (36) (37) (38) (39) (40) (41) (42) (43) (44) (45) (46) (47) (48) (49) (50) (51) (52) (53) (54) (55) (56) (57) (58) (59) (60) (61) (62) (63) (64)] (pair [(0) (0) (0) (1)] [(0)])) (pair [(65) (66) (67) (68) (69) (70) (71) (72) (73) (74) (75) (76) (77) (78) (79) (80) (81) (82) (83) (84) (85) (86) (87) (88) (89) (90) (91) (92) (93) (94) (95) (96)] (pair [(0) (0) (0) (65)] [(2) (1) (2) (3) (4) (5) (6) (7) (8) (9) (10) (11) (12) (13) (14) (15) (16) (17) (18) (19) (20) (21) (22) (23) (24) (25) (26) (27) (28) (29) (30) (31) (32) (33) (34) (35) (36) (37) (38) (39) (40) (41) (42) (43) (44) (45) (46) (47) (48) (49) (50) (51) (52) (53) (54) (55) (56) (57) (58) (59) (60) (61) (62) (63) (64)]))]"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= okT (Fork Leaf Leaf) Leaf
, testCase "readArborixTreeFromHash: reconstructs tree from bundle bytes" $ do
let nodesBytes = u64 1 ++ [1..32] ++ u32 1 ++ [0]
input = "readArborixTreeFromHash " ++ bytesExpr [1..32] ++ " " ++ bytesExpr (simpleContainerBytes [101,102,103] nodesBytes)
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= okT Leaf (bytesT ([101,102,103] ++ nodesBytes))
, testCase "readArborixExecutableFromHash: alias reconstructs tree" $ do
let nodesBytes = u64 1 ++ [1..32] ++ u32 1 ++ [0]
input = "readArborixExecutableFromHash " ++ bytesExpr [1..32] ++ " " ++ bytesExpr (simpleContainerBytes [101,102,103] nodesBytes)
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= okT Leaf (bytesT ([101,102,103] ++ nodesBytes))
, testCase "readArborixNodesSection: reads id fixture bundle" $ do
fixtureBytes <- BS.readFile "test/fixtures/id.tri.bundle"
case decodeBundle fixtureBytes of
Left err -> assertFailure $ "decodeBundle failed: " ++ err
Right _ -> do
let input = "matchResult (code rest : code) (nodes rest : 0) (readArborixNodesSection "
++ bytesExpr (map toInteger $ BS.unpack fixtureBytes)
++ ")"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= ofNumber 0
, testCase "readArborixNodesSection: reads notQ fixture bundle" $ do
fixtureBytes <- BS.readFile "test/fixtures/notQ.tri.bundle"
case decodeBundle fixtureBytes of
Left err -> assertFailure $ "decodeBundle failed: " ++ err
Right _ -> do
let input = "matchResult (code rest : code) (nodes rest : 0) (readArborixNodesSection "
++ bytesExpr (map toInteger $ BS.unpack fixtureBytes)
++ ")"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= ofNumber 0
, testCase "readArborixNodesSection: reads map fixture bundle" $ do
fixtureBytes <- BS.readFile "test/fixtures/map.tri.bundle"
case decodeBundle fixtureBytes of
Left err -> assertFailure $ "decodeBundle failed: " ++ err
Right _ -> do
let input = "matchResult (code rest : code) (nodes rest : 0) (readArborixNodesSection "
++ bytesExpr (map toInteger $ BS.unpack fixtureBytes)
++ ")"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= ofNumber 0
, testCase "readArborixExecutableFromHash: reconstructs id fixture root" $ do
fixtureBytes <- BS.readFile "test/fixtures/id.tri.bundle"
case decodeBundle fixtureBytes of
Left err -> assertFailure $ "decodeBundle failed: " ++ err
Right bundle -> case bundleRoots bundle of
[] -> assertFailure "fixture has no roots"
(rootHash:_) -> do
let input = "matchResult (code rest : code) (tree rest : 0) (readArborixExecutableFromHash "
++ bytesExpr (hexTextBytes rootHash)
++ " "
++ bytesExpr (map toInteger $ BS.unpack fixtureBytes)
++ ")"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= ofNumber 0
, testCase "readArborixExecutableFromHash: reconstructs notQ fixture root" $ do
fixtureBytes <- BS.readFile "test/fixtures/notQ.tri.bundle"
case decodeBundle fixtureBytes of
Left err -> assertFailure $ "decodeBundle failed: " ++ err
Right bundle -> case bundleRoots bundle of
[] -> assertFailure "fixture has no roots"
(rootHash:_) -> do
let input = "matchResult (code rest : code) (tree rest : 0) (readArborixExecutableFromHash "
++ bytesExpr (hexTextBytes rootHash)
++ " "
++ bytesExpr (map toInteger $ BS.unpack fixtureBytes)
++ ")"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= ofNumber 0
, testCase "readArborixExecutableFromHash: reconstructs map fixture root" $ do
fixtureBytes <- BS.readFile "test/fixtures/map.tri.bundle"
case decodeBundle fixtureBytes of
Left err -> assertFailure $ "decodeBundle failed: " ++ err
Right bundle -> case bundleRoots bundle of
[] -> assertFailure "fixture has no roots"
(rootHash:_) -> do
let input = "matchResult (code rest : code) (tree rest : 0) (readArborixExecutableFromHash "
++ bytesExpr (hexTextBytes rootHash)
++ " "
++ bytesExpr (map toInteger $ BS.unpack fixtureBytes)
++ ")"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= ofNumber 0
, testCase "readArborixExecutableFromHash: executes id fixture root" $ do
fixtureBytes <- BS.readFile "test/fixtures/id.tri.bundle"
case decodeBundle fixtureBytes of
Left err -> assertFailure $ "decodeBundle failed: " ++ err
Right bundle -> case bundleRoots bundle of
[] -> assertFailure "fixture has no roots"
(rootHash:_) -> do
let input = "matchResult (code rest : code) (tree rest : tree 42) (readArborixExecutableFromHash "
++ bytesExpr (hexTextBytes rootHash)
++ " "
++ bytesExpr (map toInteger $ BS.unpack fixtureBytes)
++ ")"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= ofNumber 42
, testCase "readArborixExecutableFromHash: executes notQ fixture on true" $ do
fixtureBytes <- BS.readFile "test/fixtures/notQ.tri.bundle"
case decodeBundle fixtureBytes of
Left err -> assertFailure $ "decodeBundle failed: " ++ err
Right bundle -> case bundleRoots bundle of
[] -> assertFailure "fixture has no roots"
(rootHash:_) -> do
let input = "matchResult (code rest : code) (tree rest : tree true) (readArborixExecutableFromHash "
++ bytesExpr (hexTextBytes rootHash)
++ " "
++ bytesExpr (map toInteger $ BS.unpack fixtureBytes)
++ ")"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= falseT
, testCase "readArborixExecutableFromHash: executes notQ fixture on false" $ do
fixtureBytes <- BS.readFile "test/fixtures/notQ.tri.bundle"
case decodeBundle fixtureBytes of
Left err -> assertFailure $ "decodeBundle failed: " ++ err
Right bundle -> case bundleRoots bundle of
[] -> assertFailure "fixture has no roots"
(rootHash:_) -> do
let input = "matchResult (code rest : code) (tree rest : tree false) (readArborixExecutableFromHash "
++ bytesExpr (hexTextBytes rootHash)
++ " "
++ bytesExpr (map toInteger $ BS.unpack fixtureBytes)
++ ")"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= trueT
, testCase "readArborixExecutableFromHash: executes map fixture root" $ do
fixtureBytes <- BS.readFile "test/fixtures/map.tri.bundle"
case decodeBundle fixtureBytes of
Left err -> assertFailure $ "decodeBundle failed: " ++ err
Right bundle -> case bundleRoots bundle of
[] -> assertFailure "fixture has no roots"
(rootHash:_) -> do
let input = "matchResult (code rest : code) (tree rest : head (tail (tree (a : (t t t)) [(t) (t) (t)]))) (readArborixExecutableFromHash "
++ bytesExpr (hexTextBytes rootHash)
++ " "
++ bytesExpr (map toInteger $ BS.unpack fixtureBytes)
++ ")"
library <- evaluateFile "./lib/arborix.tri"
let env = evalTricu library (parseTricu input)
result env @?= Fork Leaf Leaf
] ]

Binary file not shown.

Binary file not shown.

Binary file not shown.

BIN
test/fixtures/map.tri.bundle vendored Normal file

Binary file not shown.

View File

@@ -1,2 +0,0 @@
\!import "base.tri" _
main = not?

Binary file not shown.

Binary file not shown.