1 module SynacorEngine where
5 -- import System.Environment
8 -- import Data.Binary.Get
9 -- import qualified Data.ByteString.Lazy as BL
10 import qualified Data.Map.Strict as M
11 import Data.Map.Strict ((!))
16 import Control.Monad.State.Strict
17 import Control.Monad.Reader
18 import Control.Monad.Writer
19 import Control.Monad.RWS.Strict
21 type Memory = M.Map Word16 Word16
25 data Machine = Machine { _memory :: Memory
27 , _registers :: Memory
31 deriving (Show, Eq, Ord)
34 type ProgrammedMachine = RWS [Word16] [Word16] Machine
36 data ExecutionState = Runnable | Blocked | Terminated deriving (Ord, Eq, Show)
38 -- returns (returnValue, finalMachine, outputs)
40 runMachine :: [Word16] -> Machine -> (ExecutionState, Machine, [Word16])
41 runMachine inputs machine = runRWS runAll inputs machine
44 makeMachine :: Memory -> Machine
45 makeMachine memory = Machine
48 , _registers = M.fromList [ (r, 0) | r <- [0..7] ]
55 -- opcode <- getLocation cip
56 -- arg1 <- getValue (cip + 1)
57 -- arg2 <- getValue (cip + 2)
58 -- arg3 <- getValue (cip + 3)
59 -- mem <- gets _memory
60 -- regs <- gets _registers
61 -- let raw1 = mem ! (cip + 1)
62 -- let raw2 = mem ! (cip + 2)
63 -- let raw3 = mem ! (cip + 3)
67 -- , show (showHex (cip * 2) "")
69 -- , (show (showHex cip ""))
73 -- , show (showHex arg1 "")
74 -- , show (showHex arg2 "")
75 -- , show (showHex arg3 "")
77 -- , show (showHex raw1 "")
78 -- , show (showHex raw2 "")
79 -- , show (showHex raw3 "")
80 -- , show (M.elems regs)
85 runAll :: ProgrammedMachine ExecutionState
86 runAll = do cip <- gets _ip
87 opcode <- getLocation cip
88 -- opcode' <- traceMachine opcode
89 -- exState <- runStep opcode'
90 exState <- runStep opcode
92 Terminated -> return Terminated
93 Blocked -> return Blocked
97 runStep :: Word16 -> ProgrammedMachine ExecutionState
98 -- runStep n | trace (show n) False = undefined
99 runStep 0 = return Terminated
102 regR <- getLocation (cip + 1)
104 value <- getValue (cip + 2)
106 modify (\m -> m & registers . ix reg .~ value)
110 value <- getValue (cip + 1)
112 modify (\m -> m & stack %~ (value :) )
116 tgt <- getLocation (cip + 1)
117 val <- gets (\m -> head $ m ^. stack)
118 modify (\m -> m & stack %~ tail )
124 tgt <- getLocation (cip + 1)
125 b <- getValue (cip + 2)
126 c <- getValue (cip + 3)
127 putValue tgt (if b == c then 1 else 0)
128 modify (\m -> m & ip %~ (+ 4))
132 tgt <- getLocation (cip + 1)
133 b <- getValue (cip + 2)
134 c <- getValue (cip + 3)
135 putValue tgt (if b > c then 1 else 0)
140 tgt <- getLocation (cip + 1)
141 modify (\m -> m & ip .~ tgt)
145 a <- getValue (cip + 1)
146 tgt <- getLocation (cip + 2)
148 then modify (\m -> m & ip .~ tgt)
153 a <- getValue (cip + 1)
154 tgt <- getLocation (cip + 2)
156 then modify (\m -> m & ip .~ tgt)
162 a <- getLocation (cip + 1)
163 b <- getValue (cip + 2)
164 c <- getValue (cip + 3)
170 a <- getLocation (cip + 1)
171 b <- getValue (cip + 2)
172 c <- getValue (cip + 3)
178 a <- getLocation (cip + 1)
179 b <- getValue (cip + 2)
180 c <- getValue (cip + 3)
181 putValue a (b `mod` c)
186 a <- getLocation (cip + 1)
187 b <- getValue (cip + 2)
188 c <- getValue (cip + 3)
194 a <- getLocation (cip + 1)
195 b <- getValue (cip + 2)
196 c <- getValue (cip + 3)
202 a <- getLocation (cip + 1)
203 b <- getValue (cip + 2)
204 putValue a (complement b)
210 a <- getLocation (cip + 1)
211 b <- getValue (cip + 2)
218 a <- getValue (cip + 1)
219 b <- getValue (cip + 2)
226 a <- getValue (cip + 1)
227 modify (\m -> m & stack %~ ((cip + 2) :)
232 do val <- gets (\m -> head $ m ^. stack)
233 modify (\m -> m & stack %~ tail
239 v <- getValue (cip + 1)
245 do iIndex <- gets _inputIndex
248 tgt <- getLocation (cip + 1)
249 if (iIndex + 1) > (length inputs)
251 else do let char = (inputs!!iIndex)
253 modify (\m -> m & inputIndex %~ (+ 1))
265 getValue :: Word16 -> ProgrammedMachine Word16
267 do mem <- gets _memory
268 regs <- gets _registers
272 else return (regs ! (val .&. 7))
277 -- do mem <- gets _memory
278 -- return $ mem ! loc
280 -- do regs <- gets _registers
281 -- return $ regs ! (loc `shiftR` 15)
283 getLocation :: Word16 -> ProgrammedMachine Word16
285 do mem <- gets _memory
288 putValue :: Word16 -> Word16 -> ProgrammedMachine ()
290 | loc < (2 ^ 15) = modify (\m -> m & memory . ix loc .~ v)
291 | otherwise = modify (\m -> m & registers . ix (loc .&. 7) .~ v)
292 where v = value `mod` (2 ^ 15)
294 advanceIP :: Word16 -> ProgrammedMachine ()
295 advanceIP delta = modify (\m -> m & ip %~ (+ delta))