Skip to content

feat: reduced size indexes in compilation #123

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
EdenComp wants to merge 3 commits into
base: main
Choose a base branch
from
Open

feat: reduced size indexes in compilation #123

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
69b4f16
feat: reduced size indexes
EdenComp Jan 26, 2024
778c5c0
fix: linter
EdenComp Jan 26, 2024
1189ca8
fix: big endian back
EdenComp Jan 26, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
23 changes: 17 additions & 6 deletions src/Dreamberd/Bytecode/Decode.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -6,6 +6,17 @@ import Data.Bits (shiftL, (.|.))
import Data.Char (ord)
import Dreamberd.Vm (Call (..), DefineEnvType (..), Insts (..), Value (..))

parseSize :: [Char] -> Either String (Int, [Char])
parseSize (size : bytes) | length bytes >= sized = Right (parseUnsignedInt val sized, rest)
where
sized = fromEnum size
(val, rest) = splitAt sized bytes
parseSize _ = Left "Not enough space for a size"

parseUnsignedInt :: [Char] -> Int -> Int
parseUnsignedInt [] _ = 0
parseUnsignedInt (x : xs) idx = max (256 ^ (idx - 1)) 1 * fromEnum x + parseUnsignedInt xs (idx - 1)

parseInt :: [Char] -> Either String (Int, [Char])
parseInt (b1 : b2 : b3 : b4 : b5 : b6 : b7 : b8 : rest) = Right ((ord b1 `shiftL` 56) .|. (ord b2 `shiftL` 48) .|. (ord b3 `shiftL` 40) .|. (ord b4 `shiftL` 32) .|. (ord b5 `shiftL` 24) .|. (ord b6 `shiftL` 16) .|. (ord b7 `shiftL` 8) .|. ord b8, rest)
parseInt _ = Left "Not enough space for an int"
Expand All @@ -17,13 +28,13 @@ parseInteger' _ _ = Left "Not enough space for an integer"

parseInteger :: [Char] -> Either String (Integer, [Char])
parseInteger (c : bytes)
| fromEnum c == 0x51 = parseInt bytes >>= uncurry parseInteger'
| fromEnum c == 0x52 = parseInt bytes >>= \(size, rest) -> parseInteger' size rest >>= \(val, rest') -> Right (-val, rest')
| fromEnum c == 0x51 = parseSize bytes >>= uncurry parseInteger'
| fromEnum c == 0x52 = parseSize bytes >>= \(size, rest) -> parseInteger' size rest >>= \(val, rest') -> Right (-val, rest')
parseInteger _ = Left "Not enough space for an integer"

parseString :: [Char] -> Either String (String, [Char])
parseString bytes =
parseInt bytes >>= \(val, rest) ->
parseSize bytes >>= \(val, rest) ->
if length rest < val then Left "Wrong string length" else Right (splitAt val rest)

parseCall :: [Char] -> Either String (Call, [Char])
Expand All @@ -47,8 +58,8 @@ parseValue (c : bytes) = case fromEnum c of
0x14 -> parseString bytes >>= \(val, rest) -> Right (String val, rest)
0x15 -> parseCall bytes >>= \(val, rest) -> Right (Symbol val, rest)
0x16 ->
parseInt bytes >>= \(args, rest) ->
parseInt rest >>= \(len, rest') ->
parseSize bytes >>= \(args, rest) ->
parseSize rest >>= \(len, rest') ->
let (insts, rest'') = splitAt len rest' in parseInstructions insts >>= \func -> if length rest' < len then Left "Wrong lambda body length" else Right (Lambda args func, rest'')
0x17 -> Right (Void, bytes)
_ -> Left "Unknown value type"
Expand Down Expand Up @@ -80,7 +91,7 @@ parseInstructions :: [Char] -> Either String [Insts]
parseInstructions [] = Right []
parseInstructions (c : bytes) = case fromEnum c of
0x01 -> parseValue bytes >>= \(val, rest) -> pursueParsing (Push val) rest
0x02 -> parseInt bytes >>= \(val, rest) -> pursueParsing (PushArg val) rest
0x02 -> parseSize bytes >>= \(val, rest) -> pursueParsing (PushArg val) rest
0x03 -> parseString bytes >>= \(val, rest) -> pursueParsing (PushEnv val) rest
0x04 -> pursueParsing Call bytes
0x05 -> parseString bytes >>= uncurry parseDefineEnv >>= uncurry pursueParsing
Expand Down
37 changes: 24 additions & 13 deletions src/Dreamberd/Bytecode/Encode.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2,6 +2,7 @@ module Dreamberd.Bytecode.Encode (
transpileCall,
transpileInt,
transpileInteger,
transpileSize,
transpileString,
transpileValue,
transpileInstruction,
Expand All @@ -16,35 +17,45 @@ import System.Endian (Endianness (..), getSystemEndianness)
getIntegerSize :: Integer -> Int
getIntegerSize nb = if nb == 0 then 0 else 1 + getIntegerSize (nb `shiftR` 8)

transpileInt :: Int -> [Char]
transpileInt nb = case getSystemEndianness of
LittleEndian -> map chr $ reverse $ map (`mod` 256) $ take 8 $ iterate (`shiftR` 8) nb
BigEndian -> map (chr . (`mod` 256)) (take 8 $ iterate (`shiftR` 8) nb)
transpileSize :: Int -> [Char]
transpileSize nb = toEnum size : transpileInt nb size
where
size = getNumberSize nb 0

getNumberSize :: Int -> Int -> Int
getNumberSize nb idx
| nb < 256 = idx + 1
| otherwise = getNumberSize (nb `shiftR` 8) (idx + 1)

transpileInt :: Int -> Int -> [Char]
transpileInt nb size = case getSystemEndianness of
LittleEndian -> map chr $ reverse $ map (`mod` 256) $ take size $ iterate (`shiftR` 8) nb
BigEndian -> reverse $ take size $ map (chr . (`mod` 256)) (take 8 $ iterate (`shiftR` 8) nb)

transpileInteger :: Integer -> [Char]
transpileInteger nb =
(if nb >= 0 then toEnum 0x51 else toEnum 0x52) : transpileInt size ++ case getSystemEndianness of
(if nb >= 0 then toEnum 0x51 else toEnum 0x52) : transpileSize size ++ case getSystemEndianness of
LittleEndian -> map chr $ reverse $ map (`mod` 256) $ take size $ iterate (`shiftR` 8) (fromInteger (abs nb))
BigEndian -> map (chr . (`mod` 256)) (take size $ iterate (`shiftR` 8) (fromInteger (abs nb)))
where
size = getIntegerSize (abs nb)

transpileString :: String -> [Char]
transpileString str = transpileInt (length str) ++ str
transpileString str = transpileSize (length str) ++ str

transpileCall :: Call -> [Char]
transpileCall (Operator op) = toEnum 0x21 : [toEnum (0x31 + fromEnum op)]
transpileCall (Builtin builtin) = toEnum 0x22 : [toEnum (0x25 + fromEnum builtin)]

transpileValue :: Value -> [Char]
transpileValue (Integer nb) = toEnum 0x11 : transpileInt nb
transpileValue (Float nb) = toEnum 0x12 : transpileInteger l ++ transpileInt r
transpileValue (Integer nb) = toEnum 0x11 : transpileInt nb 8
transpileValue (Float nb) = toEnum 0x12 : transpileInteger l ++ transpileInt r 8
where
(l, r) = decodeFloat nb
transpileValue (Bool b) = toEnum 0x13 : (if b then [toEnum 1] else [toEnum 0])
transpileValue (String str) = toEnum 0x14 : transpileString str
transpileValue (Symbol call) = toEnum 0x15 : transpileCall call
transpileValue (Lambda args insts) = toEnum 0x16 : transpileInt args ++ transpileInt (length nested) ++ nested
transpileValue (Lambda args insts) = toEnum 0x16 : transpileSize args ++ transpileSize (length nested) ++ nested
where
nested = foldMap transpileInstruction insts
transpileValue Void = [toEnum 0x17]
Expand All @@ -55,16 +66,16 @@ transpileDefineValue (Just val) = toEnum 0x51 : transpileValue val

transpileInstruction :: Insts -> [Char]
transpileInstruction (Push v) = toEnum 0x01 : transpileValue v
transpileInstruction (PushArg idx) = toEnum 0x02 : transpileInt idx
transpileInstruction (PushArg idx) = toEnum 0x02 : transpileSize idx
transpileInstruction (PushEnv env) = toEnum 0x03 : transpileString env
transpileInstruction Call = [toEnum 0x04]
transpileInstruction (DefineEnv name Define value) = toEnum 0x05 : transpileString name ++ [toEnum 0x41] ++ transpileDefineValue value
transpileInstruction (DefineEnv name Redefine value) = toEnum 0x05 : transpileString name ++ [toEnum 0x42] ++ transpileDefineValue value
transpileInstruction (DefineEnv name Override value) = toEnum 0x05 : transpileString name ++ [toEnum 0x43] ++ transpileDefineValue value
transpileInstruction (EraseEnv name) = toEnum 0x06 : transpileString name
transpileInstruction (Jump nb (Just True)) = toEnum 0x07 : transpileInt nb ++ [toEnum 0x51]
transpileInstruction (Jump nb (Just False)) = toEnum 0x07 : transpileInt nb ++ [toEnum 0x52]
transpileInstruction (Jump nb Nothing) = toEnum 0x07 : transpileInt nb ++ [toEnum 0x53]
transpileInstruction (Jump nb (Just True)) = toEnum 0x07 : transpileInt nb 8 ++ [toEnum 0x51]
transpileInstruction (Jump nb (Just False)) = toEnum 0x07 : transpileInt nb 8 ++ [toEnum 0x52]
transpileInstruction (Jump nb Nothing) = toEnum 0x07 : transpileInt nb 8 ++ [toEnum 0x53]
transpileInstruction Ret = [toEnum 0x08]

transpileIntoBytecode :: [Insts] -> [Char]
Expand Down
45 changes: 22 additions & 23 deletions test/Unit/Dreamberd/TestDreamberdBytecode.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -24,22 +24,21 @@ testDreamberdBytecode =
testTypesTranspilation :: Test
testTypesTranspilation =
TestList
[ TestCase $ assertEqual "Transpile Int" (transpileInt 1) "\x00\x00\x00\x00\x00\x00\x00\x01"
, TestCase $ assertEqual "Transpile Int Zero" (transpileInt 0) "\x00\x00\x00\x00\x00\x00\x00\x00"
, TestCase $ assertEqual "Transpile Int Negative" (transpileInt (-1)) "\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF"
, TestCase $ assertEqual "Transpile Float" (transpileInstruction (Push (Float 1.0))) "\SOH\DC2Q\NUL\NUL\NUL\NUL\NUL\NUL\NUL\a\DLE\NUL\NUL\NUL\NUL\NUL\NUL\255\255\255\255\255\255\255\204"
, TestCase $ assertEqual "Transpile String" (transpileString "Hello") "\x00\x00\x00\x00\x00\x00\x00\x05Hello"
, TestCase $ assertEqual "Transpile String 2" (transpileString "World") "\x00\x00\x00\x00\x00\x00\x00\x05World"
, TestCase $ assertEqual "Transpile Empty String" (transpileString "") "\x00\x00\x00\x00\x00\x00\x00\x00"
[ TestCase $ assertEqual "Transpile Int" (transpileInt 1 8) "\x00\x00\x00\x00\x00\x00\x00\x01"
, TestCase $ assertEqual "Transpile Int Zero" (transpileInt 0 8) "\x00\x00\x00\x00\x00\x00\x00\x00"
, TestCase $ assertEqual "Transpile Int Negative" (transpileInt (-1) 8) "\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF"
, TestCase $ assertEqual "Transpile Float" (transpileInstruction (Push (Float 1.0))) "\x01\DC2Q\x01\a\DLE\NUL\NUL\NUL\NUL\NUL\NUL\255\255\255\255\255\255\255\204"
, TestCase $ assertEqual "Transpile String" (transpileString "Hello") "\x01\x05Hello"
, TestCase $ assertEqual "Transpile Empty String" (transpileString "") "\x01\x00"
, TestCase $ assertEqual "Transpile Call Add" (transpileCall (Operator Add)) "\x21\x31"
, TestCase $ assertEqual "Transpile Call Print" (transpileCall (Builtin Print)) "\x22\x26"
, TestCase $ assertEqual "Transpile Instruction Push" (transpileInstruction (Push (Integer 1))) "\x01\x11\x00\x00\x00\x00\x00\x00\x00\x01"
, TestCase $ assertEqual "Transpile Instruction PushArg" (transpileInstruction (PushArg 1)) "\x02\x00\x00\x00\x00\x00\x00\x00\x01"
, TestCase $ assertEqual "Transpile Instruction PushEnv" (transpileInstruction (PushEnv "test")) "\x03\x00\x00\x00\x00\x00\x00\x00\x04test"
, TestCase $ assertEqual "Transpile Instruction PushArg" (transpileInstruction (PushArg 1)) "\x02\x01\x01"
, TestCase $ assertEqual "Transpile Instruction PushEnv" (transpileInstruction (PushEnv "test")) "\x03\x01\x04test"
, TestCase $ assertEqual "Transpile Instruction Call" (transpileInstruction Call) "\x04"
, TestCase $ assertEqual "Transpile Instruction DefineEnv with value" (transpileInstruction (DefineEnv "test" Define (Just (Lambda 0 [])))) "\ENQ\NUL\NUL\NUL\NUL\NUL\NUL\NUL\EOTtestAQ\SYN\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL"
, TestCase $ assertEqual "Transpile Instruction DefineEnv from stack" (transpileInstruction (DefineEnv "test" Define Nothing)) "\x05\x00\x00\x00\x00\x00\x00\x00\x04test\x41\x53"
, TestCase $ assertEqual "Transpile Instruction EraseEnv" (transpileInstruction (EraseEnv "yo")) "\x06\x00\x00\x00\x00\x00\x00\x00\x02yo"
, TestCase $ assertEqual "Transpile Instruction DefineEnv with value" (transpileInstruction (DefineEnv "test" Define (Just (Lambda 0 [])))) "\ENQ\x01\x04testAQ\SYN\x01\x00\x01\x00"
, TestCase $ assertEqual "Transpile Instruction DefineEnv from stack" (transpileInstruction (DefineEnv "test" Define Nothing)) "\x05\x01\x04test\x41\x53"
, TestCase $ assertEqual "Transpile Instruction EraseEnv" (transpileInstruction (EraseEnv "yo")) "\x06\x01\x02yo"
, TestCase $ assertEqual "Transpile Instruction Jump" (transpileInstruction (Jump 1 Nothing)) "\x07\x00\x00\x00\x00\x00\x00\x00\x01\x53"
, TestCase $ assertEqual "Transpile Instruction Ret" (transpileInstruction Ret) "\x08"
]
Expand All @@ -48,13 +47,13 @@ testTranspilation :: Test
testTranspilation =
TestList
[ TestCase $ assertEqual "basic bytecode" (transpileIntoBytecode [Push (Integer 1), Ret]) "db4\n\x01\x11\x00\x00\x00\x00\x00\x00\x00\x01\x08\n"
, TestCase $ assertEqual "test equality between floats" (transpileIntoBytecode [Push (Float 2.0), Push (Float 3.4), Push (Symbol (Operator Eq)), Call, Ret]) "db4\n\SOH\DC2Q\NUL\NUL\NUL\NUL\NUL\NUL\NUL\a\DLE\NUL\NUL\NUL\NUL\NUL\NUL\255\255\255\255\255\255\255\205\SOH\DC2Q\NUL\NUL\NUL\NUL\NUL\NUL\NUL\a\ESC333333\255\255\255\255\255\255\255\205\SOH\NAK!7\EOT\b\n"
, TestCase $ assertEqual "abs function" (transpileIntoBytecode [DefineEnv "abs" Define (Just (Lambda 1 [Push (Integer 0), PushArg 0, Push (Symbol (Operator Less)), Call, Jump 5 (Just False), Push (Integer (-1)), PushArg 0, Push (Symbol (Operator Mul)), Call, Ret, PushArg 0, Ret]))]) "db4\n\ENQ\NUL\NUL\NUL\NUL\NUL\NUL\NUL\ETXabsAQ\SYN\NUL\NUL\NUL\NUL\NUL\NUL\NUL\SOH\NUL\NUL\NUL\NUL\NUL\NUL\NULE\SOH\DC1\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\STX\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\SOH\NAK!9\EOT\a\NUL\NUL\NUL\NUL\NUL\NUL\NUL\ENQR\SOH\DC1\255\255\255\255\255\255\255\255\STX\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\SOH\NAK!3\EOT\b\STX\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\b\n"
, TestCase $ assertEqual "function call" (transpileIntoBytecode [DefineEnv "abs" Define (Just (Lambda 1 [Push (Integer 0), PushArg 0, Push (Symbol (Operator Less)), Call, Jump 5 (Just False), Push (Integer (-1)), PushArg 0, Push (Symbol (Operator Mul)), Call, Ret, PushArg 0, Ret])), Push (Integer (-2)), PushEnv "abs", Call, Ret]) "db4\n\ENQ\NUL\NUL\NUL\NUL\NUL\NUL\NUL\ETXabsAQ\SYN\NUL\NUL\NUL\NUL\NUL\NUL\NUL\SOH\NUL\NUL\NUL\NUL\NUL\NUL\NULE\SOH\DC1\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\STX\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\SOH\NAK!9\EOT\a\NUL\NUL\NUL\NUL\NUL\NUL\NUL\ENQR\SOH\DC1\255\255\255\255\255\255\255\255\STX\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\SOH\NAK!3\EOT\b\STX\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\b\SOH\DC1\255\255\255\255\255\255\255\254\ETX\NUL\NUL\NUL\NUL\NUL\NUL\NUL\ETXabs\EOT\b\n"
, TestCase $ assertEqual "defines" (transpileIntoBytecode [Push (Float (-5.2)), DefineEnv "a" Define Nothing, DefineEnv "a" Redefine (Just (Lambda 1 [PushArg 0, Push (Bool False), Push (Symbol (Operator Neq)), Call, Ret]))]) "db4\n\SOH\DC2R\NUL\NUL\NUL\NUL\NUL\NUL\NUL\a\DC4\204\204\204\204\204\205\255\255\255\255\255\255\255\206\ENQ\NUL\NUL\NUL\NUL\NUL\NUL\NUL\SOHaAS\ENQ\NUL\NUL\NUL\NUL\NUL\NUL\NUL\SOHaBQ\SYN\NUL\NUL\NUL\NUL\NUL\NUL\NUL\SOH\NUL\NUL\NUL\NUL\NUL\NUL\NUL\DC2\STX\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\SOH\DC3\NUL\SOH\NAK!8\EOT\b\n"
, TestCase $ assertEqual "test equality between floats" (transpileIntoBytecode [Push (Float 2.0), Push (Float 3.4), Push (Symbol (Operator Eq)), Call, Ret]) "db4\n\SOH\DC2Q\SOH\a\DLE\NUL\NUL\NUL\NUL\NUL\NUL\255\255\255\255\255\255\255\205\SOH\DC2Q\SOH\a\ESC333333\255\255\255\255\255\255\255\205\SOH\NAK!7\EOT\b\n"
, TestCase $ assertEqual "abs function" (transpileIntoBytecode [DefineEnv "abs" Define (Just (Lambda 1 [Push (Integer 0), PushArg 0, Push (Symbol (Operator Less)), Call, Jump 5 (Just False), Push (Integer (-1)), PushArg 0, Push (Symbol (Operator Mul)), Call, Ret, PushArg 0, Ret]))]) "db4\n\ENQ\SOH\ETXabsAQ\SYN\SOH\SOH\SOH3\SOH\DC1\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\STX\SOH\NUL\SOH\NAK!9\EOT\a\NUL\NUL\NUL\NUL\NUL\NUL\NUL\ENQR\SOH\DC1\255\255\255\255\255\255\255\255\STX\SOH\NUL\SOH\NAK!3\EOT\b\STX\SOH\NUL\b\n"
, TestCase $ assertEqual "function call" (transpileIntoBytecode [DefineEnv "abs" Define (Just (Lambda 1 [Push (Integer 0), PushArg 0, Push (Symbol (Operator Less)), Call, Jump 5 (Just False), Push (Integer (-1)), PushArg 0, Push (Symbol (Operator Mul)), Call, Ret, PushArg 0, Ret])), Push (Integer (-2)), PushEnv "abs", Call, Ret]) "db4\n\ENQ\SOH\ETXabsAQ\SYN\SOH\SOH\SOH3\SOH\DC1\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\STX\SOH\NUL\SOH\NAK!9\EOT\a\NUL\NUL\NUL\NUL\NUL\NUL\NUL\ENQR\SOH\DC1\255\255\255\255\255\255\255\255\STX\SOH\NUL\SOH\NAK!3\EOT\b\STX\SOH\NUL\b\SOH\DC1\255\255\255\255\255\255\255\254\ETX\SOH\ETXabs\EOT\b\n"
, TestCase $ assertEqual "defines" (transpileIntoBytecode [Push (Float (-5.2)), DefineEnv "a" Define Nothing, DefineEnv "a" Redefine (Just (Lambda 1 [PushArg 0, Push (Bool False), Push (Symbol (Operator Neq)), Call, Ret]))]) "db4\n\SOH\DC2R\SOH\a\DC4\204\204\204\204\204\205\255\255\255\255\255\255\255\206\ENQ\SOH\SOHaAS\ENQ\SOH\SOHaBQ\SYN\SOH\SOH\SOH\f\STX\SOH\NUL\SOH\DC3\NUL\SOH\NAK!8\EOT\b\n"
, TestCase $ assertEqual "jump too long (should not raise)" (transpileIntoBytecode [Push (Bool True), Jump 46 (Just True), Ret]) "db4\n\SOH\DC3\SOH\a\NUL\NUL\NUL\NUL\NUL\NUL\NUL.Q\b\n"
, TestCase $ assertEqual "invalid variables for op (should not raise)" (transpileIntoBytecode [Push Void, Push (String "bonsoir a tous"), Push (Bool True), Push (Symbol (Operator Eq)), Call, Ret]) "db4\n\SOH\ETB\SOH\DC4\NUL\NUL\NUL\NUL\NUL\NUL\NUL\SObonsoir a tous\SOH\DC3\SOH\SOH\NAK!7\EOT\b\n"
, TestCase $ assertEqual "invalid redefine (should not raise)" (transpileIntoBytecode [DefineEnv "b" Define Nothing, DefineEnv "a" Redefine (Just (String "haha")), Ret]) "db4\n\ENQ\NUL\NUL\NUL\NUL\NUL\NUL\NUL\SOHbAS\ENQ\NUL\NUL\NUL\NUL\NUL\NUL\NUL\SOHaBQ\DC4\NUL\NUL\NUL\NUL\NUL\NUL\NUL\EOThaha\b\n"
, TestCase $ assertEqual "invalid variables for op (should not raise)" (transpileIntoBytecode [Push Void, Push (String "bonsoir a tous"), Push (Bool True), Push (Symbol (Operator Eq)), Call, Ret]) "db4\n\SOH\ETB\SOH\DC4\SOH\SObonsoir a tous\SOH\DC3\SOH\SOH\NAK!7\EOT\b\n"
, TestCase $ assertEqual "invalid redefine (should not raise)" (transpileIntoBytecode [DefineEnv "b" Define Nothing, DefineEnv "a" Redefine (Just (String "haha")), Ret]) "db4\n\ENQ\SOH\SOHbAS\ENQ\SOH\SOHaBQ\DC4\SOH\EOThaha\b\n"
]

testEncodeDecode :: Test
Expand All @@ -71,9 +70,9 @@ testEncodeDecode =
testDecodeErrorHandling :: Test
testDecodeErrorHandling =
TestList
[ TestCase $ assertEqual "wrong header" (getFromBytecode "db5\n\SOH\DC2Q\NUL\NUL\NUL\NUL\NUL\NUL\NUL\a\FS\NUL\NUL\NUL\NUL\NUL\NUL\255\255\255\255\255\255\255\206\n") (Left "Exec format error")
, TestCase $ assertEqual "wrong integer size (inf)" (getFromBytecode "db4\n\SOH\DC2Q\NUL\NUL\NUL\NUL\NUL\NUL\NUL\a\FS\NUL\NUL\NUL\NUL\NUL\NUL\255\255\255\255\255") (Left "Not enough space for an int")
, TestCase $ assertEqual "wrong integer size (code)" (getFromBytecode "db4\n\SOH\DC2Q\NUL\NUL\NUL\NUL\NUL\NUL\NUL\a\FS\NUL\NUL\NUL\NUL") (Left "Not enough space for an integer")
, TestCase $ assertEqual "wrong int size" (getFromBytecode "db4\n\SOH\DC2Q\NUL") (Left "Not enough space for an int")
, TestCase $ assertEqual "wrong int size" (getFromBytecode "db4\n\SOH\DC4\NUL\NUL\NUL\NUL\NUL\NUL\NUL\ENQHell\n") (Left "Wrong string length")
[ TestCase $ assertEqual "wrong header" (getFromBytecode "db5\n\SOH\DC2Q\x01\a\FS\NUL\NUL\NUL\NUL\NUL\NUL\255\255\255\255\255\255\255\206\n") (Left "Exec format error")
, TestCase $ assertEqual "wrong integer size (inf)" (getFromBytecode "db4\n\SOH\DC2Q\x01\a\FS\NUL\NUL\NUL\NUL\NUL\NUL\255\255\255\255\255") (Left "Not enough space for an int")
, TestCase $ assertEqual "wrong integer size (code)" (getFromBytecode "db4\n\SOH\DC2Q\x01\a\FS\NUL\NUL\NUL\NUL") (Left "Not enough space for an integer")
, TestCase $ assertEqual "wrong size" (getFromBytecode "db4\n\SOH\DC2Q\x02\NUL") (Left "Not enough space for a size")
, TestCase $ assertEqual "wrong int size" (getFromBytecode "db4\n\SOH\DC4\x01\ENQHell\n") (Left "Wrong string length")
]