From dee85efabf4692f38ca016f4134c2594018c5f2e Mon Sep 17 00:00:00 2001 From: James Eversole Date: Wed, 6 May 2026 19:23:30 -0500 Subject: [PATCH] Tree-native binary processing --- lib/binary.tri | 23 ++++++++++++++++++++ test/Spec.hs | 59 ++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 82 insertions(+) create mode 100644 lib/binary.tri diff --git a/lib/binary.tri b/lib/binary.tri new file mode 100644 index 0000000..1dfd27f --- /dev/null +++ b/lib/binary.tri @@ -0,0 +1,23 @@ +!import "base.tri" !Local +!import "list.tri" !Local +!import "bytes.tri" !Local + +errUnexpectedEof = 1 + +ok = value rest : pair true (pair value rest) +err = code rest : pair false (pair code rest) + +readU8 = (bytes : matchList + (err errUnexpectedEof t) + (h r : ok h r) + bytes) + +readBytesTaken = n bytes : bytesTake n bytes +readBytesRest = n bytes : bytesDrop n bytes +readBytesEnough? = n bytes : equal? (bytesLength (readBytesTaken n bytes)) n + +readBytes = (n bytes : + matchBool + (ok (readBytesTaken n bytes) (readBytesRest n bytes)) + (err errUnexpectedEof bytes) + (readBytesEnough? n bytes)) diff --git a/test/Spec.hs b/test/Spec.hs index f0dcdea..1db6c9a 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -47,6 +47,7 @@ tests = testGroup "Tricu Tests" , byteMarshallingTests , wireTests , byteListUtilities + , binaryReaderTests ] lexer :: TestTree @@ -1028,6 +1029,7 @@ wireTests = testGroup "Wire Tests" -- -------------------------------------------------------------------------- -- | Helpers for byte-list test expectations. + trueT :: T trueT = Stem Leaf @@ -1225,3 +1227,60 @@ byteListUtilities = testGroup "Byte List Utility Tests" let env = evalTricu library (parseTricu input) result env @?= falseT ] + +-- -------------------------------------------------------------------------- +-- Binary reader tests (binary.tri) +-- -------------------------------------------------------------------------- +okT :: T -> T -> T +okT value rest = pairT trueT (pairT value rest) + +errT :: T -> T -> T +errT code rest = pairT falseT (pairT code rest) + +eofT :: T +eofT = byteT 1 + +binaryReaderTests :: TestTree +binaryReaderTests = testGroup "Binary Reader Tests" + [ testCase "readU8: empty input returns err" $ do + let input = "readU8 []" + library <- evaluateFile "./lib/binary.tri" + let env = evalTricu library (parseTricu input) + result env @?= errT eofT (bytesT []) + + , testCase "readU8: single byte returns ok" $ do + let input = "readU8 [(7)]" + library <- evaluateFile "./lib/binary.tri" + let env = evalTricu library (parseTricu input) + result env @?= okT (byteT 7) (bytesT []) + + , testCase "readU8: multi-byte returns first byte and rest" $ do + let input = "readU8 [(7) (8)]" + library <- evaluateFile "./lib/binary.tri" + let env = evalTricu library (parseTricu input) + result env @?= okT (byteT 7) (bytesT [8]) + + , testCase "readBytes 0: returns ok with empty bytes and original input" $ do + let input = "readBytes 0 [(1) (2)]" + library <- evaluateFile "./lib/binary.tri" + let env = evalTricu library (parseTricu input) + result env @?= okT (bytesT []) (bytesT [1,2]) + + , testCase "readBytes 2: exact read returns ok with taken and rest" $ do + let input = "readBytes 2 [(1) (2) (3)]" + library <- evaluateFile "./lib/binary.tri" + let env = evalTricu library (parseTricu input) + result env @?= okT (bytesT [1,2]) (bytesT [3]) + + , testCase "readBytes 3: exact read with no remainder" $ do + let input = "readBytes 3 [(1) (2) (3)]" + library <- evaluateFile "./lib/binary.tri" + let env = evalTricu library (parseTricu input) + result env @?= okT (bytesT [1,2,3]) (bytesT []) + + , testCase "readBytes 5: overlong read returns err preserving input" $ do + let input = "readBytes 5 [(1) (2)]" + library <- evaluateFile "./lib/binary.tri" + let env = evalTricu library (parseTricu input) + result env @?= errT eofT (bytesT [1,2]) + ]