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"

test/Spec.hs

@@ -46,6 +46,7 @@ tests = testGroup "Tricu Tests"
   , stressElimLambda
   , byteMarshallingTests
   , wireTests
+  , byteListUtilities
   ]
 
 lexer :: TestTree
@@ -1020,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
+  ]