git @ Cat's Eye Technologies ZOWIE / 01202b3
First pass at an implementation in Haskell. Chris Pressey 11 months ago
1 changed file(s) with 79 addition(s) and 0 deletion(s). Raw diff Collapse all Expand all
0 module ZOWIE where
1
2 import qualified Data.Map.Strict as Map
3
4
5 type Addr = Integer
6 type Value = Integer
7 type Memory = Map.Map Addr Value
8
9 readMem mem addr = Map.findWithDefault 0 addr mem
10 writeMem mem addr value = Map.insert addr value mem
11
12 type CPU = Integer
13
14 data State = State {
15 cpu :: CPU,
16 mem :: Memory
17 } deriving (Show, Ord, Eq)
18
19
20 readAddr :: State -> Addr -> IO Value
21 readAddr state@State{ cpu=cpu, mem=mem } addr =
22 case addr of
23 0 -> do -- TtyRegister
24 i <- readLn
25 return i
26 1 -> return 1 -- BeginTransactionRegister
27 2 -> return 2 -- CommitRegister
28 3 -> return 3 -- CommitAndRepeatRegister
29 4 -> return 4 -- AdditionRegister
30 5 -> return 5 -- SubtractionRegister
31 6 -> return 6 -- MultiplicationRegister
32 7 -> return 7 -- NegationRegister
33 x -> return (readMem mem x)
34
35
36 writeAddr :: State -> Addr -> Value -> IO State
37 writeAddr state@State{ cpu=cpu, mem=mem } addr payload =
38 case addr of
39 0 -> do -- TtyRegister
40 print payload
41 return state
42 1 -> do -- BeginTransactionRegister
43 return state{ cpu=(beginTransaction cpu) }
44 2 -> let -- CommitRegister
45 cpu' = if payload > 0 then commit cpu else rollback cpu
46 in
47 return state{ cpu=cpu' }
48 3 -> let -- CommitAndRepeatRegister
49 cpu' = if payload > 0 then commitAndRepeat cpu else commit cpu
50 in
51 return state{ cpu=cpu' }
52 4 -> let -- AdditionRegister
53 mem' = writeMem mem 8 ((readMem mem 8) + payload)
54 in
55 return state{ mem=mem' }
56 5 -> let -- SubtractionRegister
57 mem' = writeMem mem 8 ((readMem mem 8) - payload)
58 in
59 return state{ mem=mem' }
60 6 -> let -- MultiplicationRegister
61 mem' = writeMem mem 8 ((readMem mem 8) * payload)
62 in
63 return state{ mem=mem' }
64 7 -> let -- NegationRegister
65 mem' = if payload == 0 then writeMem mem 8 1 else writeMem mem 8 0
66 in
67 return state{ mem=mem' }
68 x -> do
69 return state{ mem=(writeMem mem x payload) }
70
71
72 beginTransaction x = x
73
74 commit x = x
75
76 commitAndRepeat x = x
77
78 rollback x = x