X-Git-Url: https://git.njae.me.uk/?a=blobdiff_plain;f=src%2FSynacorEngine.hs;h=63fb20c60be300c6e4fa23402578523c8aad612d;hb=3836f842a8794a2d25cc5f8558d70becae8b7396;hp=cbd5e047c0792ade68966ec4d92788923218e446;hpb=a0df5c6aec6ff0271ab47205f915e4647fbad4ec;p=synacor-challenge.git

diff --git a/src/SynacorEngine.hs b/src/SynacorEngine.hs
index cbd5e04..63fb20c 100644
--- a/src/SynacorEngine.hs
+++ b/src/SynacorEngine.hs
@@ -1,6 +1,6 @@
 module SynacorEngine where
 
-import Debug.Trace
+-- import Debug.Trace
 
 -- import System.Environment
 import Data.Bits
@@ -12,7 +12,7 @@ import Data.Map.Strict ((!))
 import Control.Lens
 import Data.List
 import Data.Char
-import Numeric
+-- import Numeric
 
 import Control.Monad.State.Strict
 import Control.Monad.Reader
@@ -40,15 +40,15 @@ data ExecutionState = Runnable | Blocked | Terminated  deriving (Ord, Eq, Show)
 -- returns (returnValue, finalMachine, outputs)
 
 runMachine :: [Word16] -> Machine -> (ExecutionState, Machine, [Word16])
-runMachine inputs machine = runRWS runAll inputs machine
+runMachine inputs machine = runRWS (runAll (10 ^ 6)) inputs machine
 
 
 makeMachine :: Memory -> Machine
-makeMachine memory = Machine
+makeMachine mem = Machine
   { _ip = 0
   , _inputIndex = 0
   , _registers = M.fromList [ (r, 0) | r <- [0..7] ]
-  , _memory = memory
+  , _memory = mem
   , _stack = []
   , _tracing = False
   }
@@ -85,17 +85,20 @@ makeMachine memory = Machine
 --           ) x
 --      return x'
 
-runAll :: ProgrammedMachine ExecutionState
-runAll = do cip <- gets _ip
-            opcode <- getLocation cip
-            traceMachine
-            -- opcode' <- traceMachine opcode
-            -- exState <- runStep opcode'
-            exState <- runStep opcode
-            case exState of
-              Terminated -> return Terminated
-              Blocked -> return Blocked
-              _ -> runAll
+runAll :: Int -> ProgrammedMachine ExecutionState
+runAll executionLimit 
+  | executionLimit == 0 = return Terminated
+  | otherwise = 
+      do  cip <- gets _ip
+          opcode <- getLocation cip
+          traceMachine
+          -- opcode' <- traceMachine opcode
+          -- exState <- runStep opcode'
+          exState <- runStep opcode
+          case exState of
+            Terminated -> return Terminated
+            Blocked -> return Blocked
+            _ -> runAll (executionLimit - 1)
 
 
 runStep :: Word16 -> ProgrammedMachine ExecutionState
@@ -270,11 +273,33 @@ traceMachine :: ProgrammedMachine ()
 traceMachine = do
   isTracing <- gets _tracing
   when isTracing
-    do  cip <- gets _ip
+       do cip <- gets _ip
+          (l, _) <- dissembleInstruction cip
+          regs <- gets _registers
+          let regVals = intercalate "; " $ fmap show $ M.elems regs
+          stk <- gets _stack
+          let stackVals = intercalate "; " $ fmap show $ take 10 stk
+          tell $ fmap (fromIntegral . ord) (">> " ++ l ++ " : r> " ++ regVals ++ " : s> " ++ stackVals ++ "<<")
+
+runDissemble :: Word16 -> Int -> Machine -> [String]
+runDissemble startAt num machine =fst $ evalRWS (dissemble startAt num) [] machine
+
+
+dissemble :: Word16 -> Int -> ProgrammedMachine [String]
+dissemble startAt num = go startAt num []
+  where go _ 0 ls = return $ reverse ls
+        go here n ls = 
+          do (line, step) <- dissembleInstruction here
+             go (here + step) (n - 1) (line : ls)
+
+dissembleInstruction :: Word16 -> ProgrammedMachine (String, Word16)  
+dissembleInstruction cip =
+    do  -- cip <- gets _ip
         opcode <- getLocation cip
-        a <- getLocation (cip + 1)
-        b <- getLocation (cip + 2)
-        c <- getLocation (cip + 3)
+        mem <- gets _memory
+        let a = mem ! (cip + 1)
+        let b = mem ! (cip + 2)
+        let c = mem ! (cip + 3)
         let sa = show a
         let sb = show b
         let sc = show c
@@ -307,9 +332,17 @@ traceMachine = do
                 18 -> ["ret"]
                 19 -> ["out", sa, "*", sva]
                 20 -> ["in", sa, "*", sva]
-                21 -> ["noop", sa, sb, sc, "*", sva, svb, svc]
+                21 -> ["noop"]
                 _ -> ["illegal", sa, sb, sc, "*", sva, svb, svc]
-        tell $ fmap (fromIntegral . ord) (">> " ++ (show cip) ++ ": " ++ (intercalate " " traceText) ++ "<<")
+        let stepSize =
+              if | opcode `elem` [0, 18, 21] -> 1
+                 | opcode `elem` [2, 3, 6, 17, 19, 20] -> 2
+                 | opcode `elem` [1, 7, 8, 14, 15, 16] -> 3
+                 | opcode `elem` [4, 5, 9, 10, 11, 12, 13] -> 4
+                 | otherwise -> 1
+        return ( ((show cip) ++ ": " ++ (intercalate " " traceText))
+               , stepSize
+               )
 
 getValue :: Word16 -> ProgrammedMachine Word16
 getValue loc =