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
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
|
module Main
( main
) where
import Data.Bifunctor ( first
, second
)
import Data.Char ( digitToInt
, isDigit
)
import Data.Map ( Map )
import qualified Data.Map as Map
import Debug.Trace
import System.Environment ( getArgs )
data Term = Abs Term | App Term Term | Idx Int
deriving (Eq, Ord)
type Birb = Char
invalid :: a
invalid = error "invalid program state"
instance Read Term where
readsPrec _ s
| c : s' <- s, isDigit c
= [(Idx (digitToInt c), s')]
| '!' : s' <- s, [(t, s'')] <- reads s'
= [(Abs t, s'')]
| '@' : s' <- s, [(t, s'')] <- reads s', [(u, s''')] <- reads s''
= [(App t u, s''')]
| otherwise
= invalid
instance Show Term where
showsPrec _ (Abs body ) = showString "\\" . shows body
showsPrec _ (App lhs rhs) = showString "@" . shows lhs . shows rhs
showsPrec _ (Idx i ) = shows i
birbify :: Term -> Map Term Birb -> String
birbify t m | t `Map.member` m = [Map.findWithDefault invalid t m]
| (Abs a) <- t = "\\" ++ birbify a m
| (App l r) <- t = "@" ++ birbify l m ++ birbify r m
| (Idx i) <- t = show i
termify :: String -> Map Birb Term -> Term
termify [c ] m = Map.findWithDefault invalid c m
termify (c : cs) m = App (termify [c] m) (termify cs m)
termify _ _ = invalid
shift :: Int -> Term -> Term
shift i (Idx j) | i <= j = Idx $ j + 1
| otherwise = Idx j
shift i (App a b) = App (shift i a) (shift i b)
shift i (Abs a ) = Abs (shift (i + 1) a)
subst :: Int -> Term -> Term -> Term
subst i (Idx j) c | i == j = c
| j > i = Idx $ j - 1
| otherwise = Idx j
subst i (App a b) c = App (subst i a c) (subst i b c)
subst i (Abs a ) c = Abs (subst (i + 1) a (shift 0 c))
nf :: Term -> Term
nf (App l r) = case nf l of
Abs t -> nf (subst 0 t r)
t -> App t (nf r)
nf (Abs t) = Abs (nf t)
nf t = t
fromBirbs :: String -> Term
fromBirbs s =
let birbsies = Map.fromList $ second read <$> trace (show birbs) birbs
filtered = filter (`Map.member` birbsies) s
term = termify filtered birbsies
in nf term
fromTerm :: Term -> String
fromTerm t =
let flipped = (\(a, b) -> (b, a)) <$> birbs
termsies = Map.fromList $ first read <$> trace (show flipped) flipped
in birbify t termsies
main :: IO ()
main = do
args <- getArgs
file <- readFile (head args)
let reduced = fromBirbs file
print reduced
let duced = fromTerm reduced
print duced
return ()
birbs :: [(Birb, String)]
birbs =
[ ('\x1FAB6', "!!!@@201")
, ('\x1F426', "!0")
, ('\x1F54A', "!!!!@@32@10")
, ('\x1F424', "!!@0@@110")
, ('\x1F425', "!!!@0@12")
-- , ('\x1F423', "!@00!@00") --
, ('\x1F989', "!!@0@10")
, ('\x1F414', "!@00")
, ('\x1F986', "!!1")
, ('\x1F9A4', "!!@01")
-- , ('\x1F9A9', "!!@1@00!@1@00") --
, ('\x1F9A2', "!!!@@20@10")
, ('\x1FABD', "!!!!@@3@20@10")
, ('\x1F983', "!!@@100")
, ('\x1F413', "!!!@@012")
, ('\x1F99A', "!!!@1@20")
, ('\x1F99C', "!!!@2@10")
, ('\x1F985', "!!!!!@@43@@210")
-- , ('\x1F427', "!0!!!@@20@10!!1") --
]
|
