tricu

An interpreted language for exploring Tree Calculus
Log | Files | Refs | README | LICENSE

Value.hs (2301B)

      1 -- Canonical runtime value encodings. Keep demand behavior explicit.
      2 module Runtime.Value where
      3 
      4 import Runtime.Tree
      5 import Data.Word (Word8)
      6 import qualified Data.ByteString as BS
      7 
      8 -- | Encode a single byte (Word8) as a Tree Calculus number (0..255).
      9 ofByte :: Word8 -> T
     10 ofByte = ofNumber . fromIntegral
     11 
     12 -- | Decode a Tree Calculus number as a single byte (Word8).
     13 --   Rejects values outside the range 0..255.
     14 toByte :: T -> Either String Word8
     15 toByte t = case toNumber t of
     16   Left err -> Left err
     17   Right n
     18     | n >= 0 && n <= 255 -> Right (fromIntegral n)
     19     | otherwise -> Left ("Byte value out of range: " ++ show n)
     20 
     21 -- | Encode a ByteString as a Tree Calculus list of Byte trees.
     22 ofBytes :: BS.ByteString -> T
     23 ofBytes = ofList . map ofByte . BS.unpack
     24 
     25 -- | Decode a Tree Calculus list of Byte trees as a ByteString.
     26 --   Rejects non-list trees and elements that are not valid byte values (0..255).
     27 toBytes :: T -> Either String BS.ByteString
     28 toBytes t = case toList t of
     29   Left err -> Left err
     30   Right bs -> BS.pack <$> mapM toByte bs
     31 
     32 -- Marshalling
     33 ofString :: String -> T
     34 ofString str = ofList $ map (ofNumber . toInteger . fromEnum) str
     35 
     36 ofNumber :: Integer -> T
     37 ofNumber 0 = Leaf
     38 ofNumber n =
     39   Fork
     40     (if odd n then Stem Leaf else Leaf)
     41     (ofNumber (n `div` 2))
     42 
     43 ofList :: [T] -> T
     44 ofList = foldr Fork Leaf
     45 
     46 toNumber :: T -> Either String Integer
     47 toNumber Leaf = Right 0
     48 toNumber (Fork Leaf rest) = case toNumber rest of
     49   Right n -> Right (2 * n)
     50   Left err -> Left err
     51 toNumber (Fork (Stem Leaf) rest) = case toNumber rest of
     52   Right n -> Right (1 + 2 * n)
     53   Left err -> Left err
     54 toNumber _ = Left "Invalid Tree Calculus number"
     55 
     56 toChar :: Integer -> Either String Char
     57 toChar n
     58   | n < 0                    = Left "Negative character code"
     59   | n > 0x10FFFF             = Left "Character code out of Unicode range"
     60   | n >= 0xD800 && n <= 0xDFFF = Left "Surrogate character code not allowed"
     61   | otherwise                = Right (toEnum (fromInteger n))
     62 
     63 toString :: T -> Either String String
     64 toString tc = do
     65   list <- toList tc
     66   nums <- mapM toNumber list
     67   mapM toChar nums
     68 
     69 toList :: T -> Either String [T]
     70 toList Leaf = Right []
     71 toList (Fork x rest) = case toList rest of
     72   Right xs -> Right (x : xs)
     73   Left err -> Left err
     74 toList _ = Left "Invalid Tree Calculus list"
     75