-
Notifications
You must be signed in to change notification settings - Fork 11
/
Input.hs
136 lines (113 loc) · 3.81 KB
/
Input.hs
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
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
module Input where
import VM
import Tokens
{- Input to the whitespace VM.
For convenience, three input characters
A => space, B => tab, C => either of CR/LF
Numbers are binary (A=0, B=1, C=terminator)
Strings are sequences of binary characters, terminated by C.
We have:
* Stack instructions (Preceded by A)
Push n A
Copy nth BA
Shuffle BBA
Slide n BC
Dup CA
Swap CB
Discard CC
* Arithmetic (Preceded by BA)
Plus AA
Minus AB
Times AC
Divide BA
Modulo BB
* Heap access (Preceded by BB)
Store A
Retrieve B
* Control (Preceded by C)
Label String AA
Call Label AB
Jump Label AC
If Zero Label BA
If Neg Label BB
Return BC
End CC
* IO instructions (Preceded by BC)
OutputChar AA
OutputNum AB
ReadChar BA
ReadNum BB
-}
execute :: String -> IO ()
execute fname = do
prog <- readFile fname
let tokens = tokenise prog
let runtime = parse tokens
vm (VM runtime (Stack []) (Stack []) [] 0)
tokenise :: String -> [Token]
tokenise [] = []
tokenise (x:xs) | [x] == show A = A:(tokenise xs)
| [x] == show B = B:(tokenise xs)
| [x] == show C = C:(tokenise xs)
| otherwise = tokenise xs
parse :: [Token] -> Program
parse [] = []
parse (A:A:xs) = let (num,rest) = parseNumber xs in
(Push num):(parse rest)
parse (A:C:A:xs) = Dup:(parse xs)
parse (A:B:A:xs) = let (num,rest) = parseNumber xs in
(Ref num):(parse rest)
parse (A:B:B:A:xs) = Shuffle:(parse xs)
parse (A:B:C:xs) = let (num,rest) = parseNumber xs in
(Slide num):(parse rest)
parse (A:C:B:xs) = Swap:(parse xs)
parse (A:C:C:xs) = Discard:(parse xs)
parse (B:A:A:A:xs) = (Infix Plus):(parse xs)
parse (B:A:A:B:xs) = (Infix Minus):(parse xs)
parse (B:A:A:C:xs) = (Infix Times):(parse xs)
parse (B:A:B:A:xs) = (Infix Divide):(parse xs)
parse (B:A:B:B:xs) = (Infix Modulo):(parse xs)
parse (B:B:A:xs) = Store:(parse xs)
parse (B:B:B:xs) = Retrieve:(parse xs)
parse (C:A:A:xs) = let (string,rest) = parseString xs in
(Label string):(parse rest)
parse (C:A:B:xs) = let (string,rest) = parseString xs in
(Call string):(parse rest)
parse (C:A:C:xs) = let (string,rest) = parseString xs in
(Jump string):(parse rest)
parse (C:B:A:xs) = let (string,rest) = parseString xs in
(If Zero string):(parse rest)
parse (C:B:B:xs) = let (string,rest) = parseString xs in
(If Negative string):(parse rest)
parse (C:B:C:xs) = Return:(parse xs)
parse (C:C:C:xs) = End:(parse xs)
parse (B:C:A:A:xs) = OutputChar:(parse xs)
parse (B:C:A:B:xs) = OutputNum:(parse xs)
parse (B:C:B:A:xs) = ReadChar:(parse xs)
parse (B:C:B:B:xs) = ReadNum:(parse xs)
parse _ = error "Unrecognised input"
parseNumber :: Num x => [Token] -> (x, [Token])
parseNumber ts = parseNum' ts []
where
parseNum' (C:rest) acc = (makeNumber acc,rest)
parseNum' (x:rest) acc = parseNum' rest (x:acc)
parseString :: [Token] -> (String, [Token])
parseString ts = parseStr' ts []
where
parseStr' (C:rest) acc = (makeString acc,rest)
parseStr' (x:rest) acc = parseStr' rest (x:acc)
makeNumber :: Num x => [Token] -> x
makeNumber t
| (last t) == A = makeNumber' (init t) 1
| otherwise = -(makeNumber' (init t) 1)
where
makeNumber' [] pow = 0
makeNumber' (A:rest) pow = (makeNumber' rest (pow*2))
makeNumber' (B:rest) pow = pow + (makeNumber' rest (pow*2))
makeString :: [Token] -> String
makeString [] = ""
makeString (t:ts) = (show t)++(makeString ts)
{-
let fst = take 8 ts in
let rest = drop 8 ts in
(toEnum (makeNumber fst)):(makeString rest) -}