blob: 59d4b11870badd3996d29a40cf7afe8f40e4d791 (
plain) (
blame)
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
|
implementation module Brainfuck
import StdEnv
instance == Command where
== INC INC = True
== DEC DEC = True
== INCP INCP = True
== DECP DECP = True
== OUT OUT = True
== IN IN = True
== IFZ IFZ = True
== IFNZ IFNZ = True
== _ _ = False
// Run a program
run :: Program *env -> *env | FileSystem env
run p world = run` p 0 0 (createArray 10000 0) world
where
run` :: Program InstrPointer DataPointer Tape *env -> *env | FileSystem env
run` p iptr dptr t world
| iptr >= size p = world
| p.[iptr] == INC || p.[iptr] == DEC
= run` p (iptr + 1) dptr (apply (p.[iptr]) dptr t) world
| p.[iptr] == INCP = run` p (iptr + 1) (dptr + 1) t world
| p.[iptr] == DECP = run` p (iptr + 1) (dptr - 1) t world
| p.[iptr] == IFZ && t.[dptr] <> 0 = run` p (iptr + 1) dptr t world
| p.[iptr] == IFZ = run` p (forward p iptr) dptr t world
| p.[iptr] == IFNZ && t.[dptr] == 0 = run` p (iptr + 1) dptr t world
| p.[iptr] == IFNZ = run` p (backward p iptr) dptr t world
// must be IN / OUT now
# (io,world) = stdio world
| p.[iptr] == IN
# (ok,c,io) = freadc io
| not ok = abort "Couldn't read input"
# (ok,world) = fclose io world
| not ok = abort "Couldn't close stdio"
= run` p (iptr + 1) dptr {t & [dptr] = toInt c} world
// must be OUT now
# (d,t) = t![dptr]
# io = io <<< toChar d
# (ok,world) = fclose io world
| not ok = abort "Couldn't close stdio"
= run` p (iptr + 1) dptr t world
where
convert :: Cell -> Cell
convert n = max 0 (min 255 n)
apply :: Command DataPointer Tape -> Tape
apply INC dptr t
# (d,t) = t![dptr]
= {t & [dptr] = d + 1}
apply DEC dptr t
# (d,t) = t![dptr]
= {t & [dptr] = d - 1}
forward` :: Program InstrPointer Int -> InstrPointer
forward` _ ptr 0 = ptr
forward` p ptr i
| p.[ptr] == IFZ = forward` p (ptr+1) (i+1)
| p.[ptr] == IFNZ = forward` p (ptr+1) (i-1)
= forward` p (ptr+1) i
backward` :: Program InstrPointer Int -> InstrPointer
backward` _ ptr 0 = ptr + 1
backward` p ptr i
| p.[ptr] == IFZ = backward` p (ptr-1) (i-1)
| p.[ptr] == IFNZ = backward` p (ptr-1) (i+1)
= backward` p (ptr-1) i
forward :: Program InstrPointer -> InstrPointer
forward p ptr = forward` p (ptr+1) 1
backward :: Program InstrPointer -> InstrPointer
backward p ptr = backward` p (ptr-1) 1
// Read a string into a program
read :: String -> Program
read s = {readC c \\ c <- fromString s | isMember c ['><+-.,[]']}
where
readC :: Char -> Command
readC '>' = INCP
readC '<' = DECP
readC '+' = INC
readC '-' = DEC
readC '.' = OUT
readC ',' = IN
readC '[' = IFZ
readC ']' = IFNZ
|
