Tree-native byte processing

lib/bytes.tri

@@ -0,0 +1,49 @@
+!import "base.tri" !Local
+!import "list.tri" !Local
+
+nothing = t
+just = x : t x
+
+bytesIsNil = emptyList?
+
+bytesHead = matchList nothing (h _ : just h)
+
+bytesTail = matchList nothing (_ r : just r)
+
+byteEq = equal?
+bytesLength = length
+bytesAppend = append
+
+bytesTake_ = y (self n i remaining :
+  matchBool
+    t
+    (matchList
+      t
+      (h r : pair h (self n (succ i) r))
+      remaining)
+    (equal? i n))
+
+bytesTake = n bytes : bytesTake_ n 0 bytes
+
+bytesDrop_ = y (self n i remaining :
+  matchBool
+    remaining
+    (matchList
+      t
+      (_ r : self n (succ i) r)
+      remaining)
+    (equal? i n))
+
+bytesDrop = n bytes : bytesDrop_ n 0 bytes
+
+bytesSplitAt = n bytes : pair (bytesTake n bytes) (bytesDrop n bytes)
+
+bytesEq = y (self xs ys :
+  matchList
+    (matchList true (_ _ : false) ys)
+    (xh xt :
+      matchList
+        false
+        (yh yt : and? (byteEq xh yh) (self xt yt))
+        ys)
+    xs)

src/Lexer.hs

@@ -62,6 +62,7 @@ identifierWithHash = do
   rest  <- many $ letterChar
               <|> digitChar <|> char '_' <|> char '-' <|> char '?'
               <|> char '$'  <|> char '@' <|> char '%'
+                        <|> char '\''
   _ <- char '#' -- Consume '#'
   hashString <- some (alphaNumChar <|> char '-') -- Ensures at least one char for hash
                 <?> "hash characters (alphanumeric or hyphen)"
@@ -83,6 +84,7 @@ identifier = do
   rest  <- many $ letterChar
               <|> digitChar <|> char '_' <|> char '-' <|> char '?'
               <|> char '$'  <|> char '@' <|> char '%'
+                        <|> char '\''
   let name = first : rest
   if name == "t" || name == "!result"
     then fail "Keywords (`t`, `!result`) cannot be used as an identifier"

src/Research.hs

@@ -7,6 +7,7 @@ import Data.List                 (intercalate)
 import Data.Map                  ()
 import Data.Text                 (Text, replace)
 import Data.Text.Encoding        (decodeUtf8, encodeUtf8)
+import Data.Word                 (Word8)
 import System.Console.CmdArgs    (Data, Typeable)
 
 import qualified Data.ByteString as BS
@@ -109,6 +110,61 @@ deserializeNode bs =
 
     _ -> errorWithoutStackTrace "invalid merkle node payload"
 
+-- ---------------------------------------------------------------------------
+-- ByteString / bytestream marshalling via existing Tree Calculus conventions
+-- ---------------------------------------------------------------------------
+
+-- | Encode a single byte (Word8) as a Tree Calculus number (0..255).
+ofByte :: Word8 -> T
+ofByte = ofNumber . fromIntegral
+
+-- | Decode a Tree Calculus number as a single byte (Word8).
+--   Rejects values outside the range 0..255.
+toByte :: T -> Either String Word8
+toByte t = case toNumber t of
+  Left err -> Left err
+  Right n
+    | n >= 0 && n <= 255 -> Right (fromIntegral n)
+    | otherwise -> Left ("Byte value out of range: " ++ show n)
+
+-- | Encode a ByteString as a Tree Calculus list of Byte trees.
+ofBytes :: BS.ByteString -> T
+ofBytes = ofList . map ofByte . BS.unpack
+
+-- | Decode a Tree Calculus list of Byte trees as a ByteString.
+--   Rejects non-list trees and elements that are not valid byte values (0..255).
+toBytes :: T -> Either String BS.ByteString
+toBytes t = case toList t of
+  Left err -> Left err
+  Right bs -> BS.pack <$> mapM toByte bs
+
+-- | Convert a canonical Arborix node payload (ByteString) to a Tree
+--   representation (a list of Byte trees).
+nodePayloadToTreeBytes :: BS.ByteString -> T
+nodePayloadToTreeBytes = ofBytes
+
+-- | Convert a Tree representation of a node payload back to ByteString.
+treeBytesToNodePayload :: T -> Either String BS.ByteString
+treeBytesToNodePayload = toBytes
+
+-- | Convert a MerkleHash (hex-encoded) to a Tree of its 32 raw bytes.
+hashToTreeBytes :: MerkleHash -> Either String T
+hashToTreeBytes h = case decode (encodeUtf8 h) of
+  Left _  -> Left "Invalid hex MerkleHash"
+  Right raw
+    | BS.length raw == 32 -> Right (ofBytes raw)
+    | otherwise -> Left "Hash raw bytes must be 32 bytes"
+
+-- | Convert a Tree of 32 Byte trees back to a MerkleHash (hex string).
+treeBytesToHash :: T -> Either String MerkleHash
+treeBytesToHash t = case toList t of
+  Left err -> Left err
+  Right bytes
+    | length bytes == 32 -> do
+        raw <- BS.pack <$> mapM toByte bytes
+        Right $ decodeUtf8 (encode raw)
+    | otherwise -> Left "Expected exactly 32 byte elements for hash"
+
 -- | Build a Merkle DAG from a Tree Calculus term.
 buildMerkle :: T -> Node
 buildMerkle Leaf = NLeaf

test/Spec.hs

@@ -44,7 +44,9 @@ tests = testGroup "Tricu Tests"
   , decoding
   , elimLambdaSingle
   , stressElimLambda
+  , byteMarshallingTests
   , wireTests
+  , byteListUtilities
   ]
 
 lexer :: TestTree
@@ -650,6 +652,102 @@ stressElimLambda = testCase "stress elimLambda on wide list under deep curried l
       after  = result (evalTricu Map.empty out)
   after @?= before
 
+-- --------------------------------------------------------------------------
+-- Byte marshalling tests
+-- --------------------------------------------------------------------------
+
+byteMarshallingTests :: TestTree
+byteMarshallingTests = testGroup "Byte Marshalling Tests"
+  [ testCase "ofByte / toByte round-trip: 0" $ do
+      let w8 = (0 :: Word8)
+      toByte (ofByte w8) @?= Right w8
+
+  , testCase "ofByte / toByte round-trip: 1" $ do
+      let w8 = (1 :: Word8)
+      toByte (ofByte w8) @?= Right w8
+
+  , testCase "ofByte / toByte round-trip: 127" $ do
+      let w8 = (127 :: Word8)
+      toByte (ofByte w8) @?= Right w8
+
+  , testCase "ofByte / toByte round-trip: 128" $ do
+      let w8 = (128 :: Word8)
+      toByte (ofByte w8) @?= Right w8
+
+  , testCase "ofByte / toByte round-trip: 255" $ do
+      let w8 = (255 :: Word8)
+      toByte (ofByte w8) @?= Right w8
+
+  , testCase "toByte rejects value > 255" $ do
+      -- ofNumber 256 = Fork Leaf (Fork Leaf Leaf) — value 256
+      toByte (ofNumber 256) @?= Left "Byte value out of range: 256"
+
+  , testCase "toByte accepts Leaf" $ do
+      toByte (Leaf) @?= Right 0
+
+  , testCase "toByte rejects non-number tree" $ do
+      toByte (Stem Leaf) @?= Left "Invalid Tree Calculus number"
+      toByte (Stem (Stem Leaf)) @?= Left "Invalid Tree Calculus number"
+
+  , testCase "ofBytes / toBytes round-trip: empty ByteString" $ do
+      toBytes (ofBytes BS.empty) @?= Right BS.empty
+
+  , testCase "ofBytes / toBytes round-trip: [0x00]" $ do
+      toBytes (ofBytes (BS.pack [0x00])) @?= Right (BS.pack [0x00])
+
+  , testCase "ofBytes / toBytes round-trip: [0xff]" $ do
+      toBytes (ofBytes (BS.pack [0xff])) @?= Right (BS.pack [0xff])
+
+  , testCase "ofBytes / toBytes round-trip: mixed bytes" $ do
+      let bytes = BS.pack [0x00, 0x01, 0x7f, 0x80, 0xff, 0x41, 0x42, 0x43]
+      toBytes (ofBytes bytes) @?= Right bytes
+
+  , testCase "toBytes rejects non-list tree" $ do
+      -- Leaf is a valid list (empty), so this won't work.
+      -- Stem Leaf is not a list.
+      toBytes (Stem Leaf) @?= Left "Invalid Tree Calculus list"
+
+  , testCase "toBytes rejects list containing invalid byte (>255)" $ do
+      -- [ofNumber 256, ofNumber 1] — first element is > 255
+      let badList = ofList [ofNumber 256, ofNumber 1]
+      toBytes badList @?= Left "Byte value out of range: 256"
+
+  , testCase "nodePayloadToTreeBytes / treeBytesToNodePayload: Leaf payload" $ do
+      -- Leaf payload is 0x00 (1 byte)
+      let payload = BS.pack [0x00]
+      treeBytesToNodePayload (nodePayloadToTreeBytes payload) @?= Right payload
+
+  , testCase "nodePayloadToTreeBytes / treeBytesToNodePayload: Stem payload" $ do
+      -- Stem payload: 0x01 || 32-byte hash = 33 bytes
+      let payload = BS.pack (0x01 : replicate 32 0x42)
+      treeBytesToNodePayload (nodePayloadToTreeBytes payload) @?= Right payload
+
+  , testCase "nodePayloadToTreeBytes / treeBytesToNodePayload: Fork payload" $ do
+      -- Fork payload: 0x02 || 32-byte hash || 32-byte hash = 65 bytes
+      let payload = BS.pack (0x02 : replicate 64 0x42)
+      treeBytesToNodePayload (nodePayloadToTreeBytes payload) @?= Right payload
+
+  , testCase "hashToTreeBytes / treeBytesToHash round-trip" $ do
+      -- Use a known 32-byte hash (SHA256 of "")
+      let hashStr :: MerkleHash
+          hashStr = "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855"
+      case hashToTreeBytes hashStr of
+        Left err -> assertFailure $ "hashToTreeBytes failed: " ++ err
+        Right tree -> treeBytesToHash tree @?= Right hashStr
+
+  , testCase "hashToTreeBytes rejects invalid hex hash" $ do
+      hashToTreeBytes "not-a-hash" @?= Left "Invalid hex MerkleHash"
+
+  , testCase "hashToTreeBytes rejects non-32-byte hash" $ do
+      -- "00" decodes to 1 byte, not 32
+      hashToTreeBytes "00" @?= Left "Hash raw bytes must be 32 bytes"
+
+  , testCase "treeBytesToHash rejects wrong byte count" $ do
+      -- Only 16 bytes, not 32
+      let t16 = ofBytes (BS.pack [0x41 | _ <- [1..16]])
+      treeBytesToHash t16 @?= Left "Expected exactly 32 byte elements for hash"
+  ]
+
 -- --------------------------------------------------------------------------
 -- Wire module tests
 -- --------------------------------------------------------------------------
@@ -923,3 +1021,207 @@ wireTests = testGroup "Wire Tests"
           close dstConn
       close srcConn
     ]
+
+-- --------------------------------------------------------------------------
+-- Byte-list utility tests
+-- Expected values built with canonical Haskell-side T constructors.
+-- --------------------------------------------------------------------------
+
+-- | Helpers for byte-list test expectations.
+trueT  :: T
+trueT  = Stem Leaf
+
+falseT :: T
+falseT = Leaf
+
+nothingT :: T
+nothingT = Leaf
+
+justT :: T -> T
+justT = Stem
+
+pairT :: T -> T -> T
+pairT = Fork
+
+byteT :: Integer -> T
+byteT = ofNumber
+
+bytesT :: [Integer] -> T
+bytesT = ofList . fmap byteT
+
+byteListUtilities :: TestTree
+byteListUtilities = testGroup "Byte List Utility Tests"
+  [ testCase "isNil: empty list is nil" $ do
+      let input = "bytesIsNil []"
+      library <- evaluateFile "./lib/bytes.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= trueT
+
+  , testCase "isNil: non-empty list is not nil" $ do
+      let input = "bytesIsNil [(1)]"
+      library <- evaluateFile "./lib/bytes.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= falseT
+
+  , testCase "head: empty list is nothing" $ do
+      let input = "bytesHead []"
+      library <- evaluateFile "./lib/bytes.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= nothingT
+
+  , testCase "head: non-empty list returns first element" $ do
+      let input = "bytesHead [(1) (2)]"
+      library <- evaluateFile "./lib/bytes.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= justT (byteT 1)
+
+  , testCase "tail: empty list is nothing" $ do
+      let input = "bytesTail []"
+      library <- evaluateFile "./lib/bytes.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= nothingT
+
+  , testCase "tail: non-empty list returns rest" $ do
+      let input = "bytesTail [(1) (2)]"
+      library <- evaluateFile "./lib/bytes.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= justT (bytesT [2])
+
+  , testCase "length: empty list is zero" $ do
+      let input = "bytesLength []"
+      library <- evaluateFile "./lib/bytes.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= ofNumber 0
+
+  , testCase "length: single element list is one" $ do
+      let input = "bytesLength [(1)]"
+      library <- evaluateFile "./lib/bytes.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= ofNumber 1
+
+  , testCase "length: three element list is three" $ do
+      let input = "bytesLength [(1) (2) (3)]"
+      library <- evaluateFile "./lib/bytes.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= ofNumber 3
+
+  , testCase "append: empty ++ [1,2] = [1,2]" $ do
+      let input = "bytesAppend [] [(1) (2)]"
+      library <- evaluateFile "./lib/bytes.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= bytesT [1,2]
+
+  , testCase "append: [1,2] ++ [3] = [1,2,3]" $ do
+      let input = "bytesAppend [(1) (2)] [(3)]"
+      library <- evaluateFile "./lib/bytes.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= bytesT [1,2,3]
+
+  , testCase "append: [1,2] ++ empty = [1,2]" $ do
+      let input = "bytesAppend [(1) (2)] []"
+      library <- evaluateFile "./lib/bytes.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= bytesT [1,2]
+
+  , testCase "take: take 0 any list = empty" $ do
+      let input = "bytesTake 0 [(1) (2) (3)]"
+      library <- evaluateFile "./lib/bytes.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= bytesT []
+
+  , testCase "take: take 2 [1,2,3] = [1,2]" $ do
+      let input = "bytesTake 2 [(1) (2) (3)]"
+      library <- evaluateFile "./lib/bytes.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= bytesT [1,2]
+
+  , testCase "take: take 5 [1,2] = [1,2] (overlong)" $ do
+      let input = "bytesTake 5 [(1) (2)]"
+      library <- evaluateFile "./lib/bytes.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= bytesT [1,2]
+
+  , testCase "drop: drop 0 any list = list" $ do
+      let input = "bytesDrop 0 [(1) (2) (3)]"
+      library <- evaluateFile "./lib/bytes.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= bytesT [1,2,3]
+
+  , testCase "drop: drop 2 [1,2,3] = [3]" $ do
+      let input = "bytesDrop 2 [(1) (2) (3)]"
+      library <- evaluateFile "./lib/bytes.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= bytesT [3]
+
+  , testCase "drop: drop 5 [1,2] = empty (overlong)" $ do
+      let input = "bytesDrop 5 [(1) (2)]"
+      library <- evaluateFile "./lib/bytes.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= bytesT []
+
+  , testCase "splitAt: splitAt 0 [1,2] = pair [] [1,2]" $ do
+      let input = "bytesSplitAt 0 [(1) (2)]"
+      library <- evaluateFile "./lib/bytes.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= pairT (bytesT []) (bytesT [1,2])
+
+  , testCase "splitAt: splitAt 2 [1,2,3] = pair [1,2] [3]" $ do
+      let input = "bytesSplitAt 2 [(1) (2) (3)]"
+      library <- evaluateFile "./lib/bytes.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= pairT (bytesT [1,2]) (bytesT [3])
+
+  , testCase "splitAt: splitAt 5 [1,2] = pair [1,2] []" $ do
+      let input = "bytesSplitAt 5 [(1) (2)]"
+      library <- evaluateFile "./lib/bytes.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= pairT (bytesT [1,2]) (bytesT [])
+
+  , testCase "byteEq: equal bytes are equal" $ do
+      let input = "byteEq 1 1"
+      library <- evaluateFile "./lib/bytes.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= trueT
+
+  , testCase "byteEq: unequal bytes are not equal" $ do
+      let input = "byteEq 1 2"
+      library <- evaluateFile "./lib/bytes.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= falseT
+
+  , testCase "bytesEq: empty == empty" $ do
+      let input = "bytesEq [] []"
+      library <- evaluateFile "./lib/bytes.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= trueT
+
+  , testCase "bytesEq: empty != [1]" $ do
+      let input = "bytesEq [] [(1)]"
+      library <- evaluateFile "./lib/bytes.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= falseT
+
+  , testCase "bytesEq: [1] != empty" $ do
+      let input = "bytesEq [(1)] []"
+      library <- evaluateFile "./lib/bytes.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= falseT
+
+  , testCase "bytesEq: equal lists are equal" $ do
+      let input = "bytesEq [(1) (2) (3)] [(1) (2) (3)]"
+      library <- evaluateFile "./lib/bytes.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= trueT
+
+  , testCase "bytesEq: different last element" $ do
+      let input = "bytesEq [(1) (2) (3)] [(1) (2) (4)]"
+      library <- evaluateFile "./lib/bytes.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= falseT
+
+  , testCase "bytesEq: different lengths" $ do
+      let input = "bytesEq [(1) (2)] [(1) (2) (3)]"
+      library <- evaluateFile "./lib/bytes.tri"
+      let env = evalTricu library (parseTricu input)
+      result env @?= falseT
+  ]