-
Notifications
You must be signed in to change notification settings - Fork 0
/
Tape.hs
43 lines (32 loc) · 828 Bytes
/
Tape.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
module Tape (
Tape
, newTape
, left
, right
, incr
, decr
, inChar
, outChar
, is0
) where
import Control.Applicative
data Tape = Tape { _prev :: [Char], val :: Char, _next :: [Char] }
newTape :: Tape
newTape = Tape (repeat '\0') '\0' (repeat '\0')
left :: Tape -> Tape
left (Tape (l:ls) v rs) = Tape ls l (v:rs)
right :: Tape -> Tape
right (Tape ls v (r:rs)) = Tape (v:ls) r rs
incr :: Tape -> Tape
incr (Tape ls v rs) = Tape ls v' rs
where v' = if v >= '\255' then '\0' else succ v
decr :: Tape -> Tape
decr (Tape ls v rs) = Tape ls v' rs
where v' = if v <= '\0' then '\255' else pred v
inChar :: Tape -> IO Tape
inChar (Tape ls _ rs) = (\c -> Tape ls c rs) <$> getChar
outChar :: Tape -> IO ()
outChar (Tape _ c _) = putChar c
is0 :: Tape -> Bool
is0 (Tape _ '\0' _) = True
is0 _ = False