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
|
-- MIT License, Copyright (c) 2022 Marvin Borner
module Binary
( toBinary
, fromBinary
, toBitString
, fromBitString
, fromJot
) where
import qualified Data.BitString as Bit
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'
toBitString :: String -> Bit.BitString
toBitString = Bit.fromList . map
(\case
'0' -> False
'1' -> True
_ -> invalidProgramState
)
fromBitString :: Bit.BitString -> String
fromBitString =
map
(\case
False -> '0'
True -> '1'
)
. Bit.toList
---
fromJot :: String -> Expression
fromJot = worker . reverse
where
s = Function $ NormalFunction "s"
k = Function $ NormalFunction "k"
worker ('0' : xs) = Application (Application (worker xs) s) k
worker ('1' : xs) = Application s (Application k (worker xs))
worker _ = Abstraction (Bruijn 0)
|
