1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
|
-- MIT License, Copyright (c) 2022 Marvin Borner
module Binary
( toBinary
, fromBinary
, toBitString
, fromBitString
) where
import Data.Binary ( decode
, encode
)
import qualified Data.BitString as Bit
import Data.Word ( Word8 )
import Helper
toBinary :: Expression -> String
toBinary (Bruijn x ) = replicate (x + 1) '1' ++ "0"
toBinary (Abstraction e ) = "00" ++ toBinary e
toBinary (Application exp1 exp2) = "01" ++ toBinary exp1 ++ toBinary exp2
toBinary _ = invalidProgramState
fromBinary' :: String -> (Expression, String)
fromBinary' inp = case inp of
'0' : '0' : rst -> let (e, es) = fromBinary' rst in (Abstraction e, es)
'0' : '1' : rst ->
let (exp1, rst1) = fromBinary' rst
(exp2, rst2) = fromBinary' rst1
in (Application exp1 exp2, rst2)
'1' : _ : rst -> binaryBruijn rst
_ -> invalidProgramState
where
binaryBruijn rst =
let idx = length (takeWhile (== '1') inp) - 1
in case rst of
"" -> (Bruijn idx, "")
_ -> (Bruijn idx, drop idx rst)
fromBinary :: String -> Expression
fromBinary = fst . fromBinary'
-- 1 byte indicating bit-padding at end + n bytes filled with bits
-- TODO: technically only 1 nibble is needed (use other nibble for versioning/sth?)
toBitString :: String -> Bit.BitString
toBitString str = Bit.concat
[ Bit.bitStringLazy $ encode (fromIntegral $ length str `mod` 8 :: Word8)
, Bit.fromList $ map
(\case
'0' -> False
'1' -> True
_ -> invalidProgramState
)
str
]
fromBitString :: Bit.BitString -> String
fromBitString bits =
map
(\case
False -> '0'
True -> '1'
)
$ Bit.toList
$ Bit.take (Bit.length bits - fromIntegral (pad bits))
$ Bit.drop 8 bits
where
pad :: Bit.BitString -> Word8
pad = decode . Bit.realizeBitStringLazy . Bit.take 8
|
