Done tracing

[synacor-challenge.git] / src / SynacorEngine.hs

diff --git a/src/SynacorEngine.hs b/src/SynacorEngine.hs
index e036f5c09193e91fd7e0b74f5704d53e3318ed1e..cbd5e047c0792ade68966ec4d92788923218e446 100644 (file)
--- a/src/SynacorEngine.hs
+++ b/src/SynacorEngine.hs
@@ -11,6 +11,7 @@ import qualified Data.Map.Strict as M
 import Data.Map.Strict ((!))
 import Control.Lens
 import Data.List
+import Data.Char
 import Numeric
 
 import Control.Monad.State.Strict
@@ -27,6 +28,7 @@ data Machine = Machine { _memory :: Memory
                        , _registers :: Memory
                        , _inputIndex :: Int
                        , _stack :: [Word16]
+                       , _tracing :: Bool
                        } 
                deriving (Show, Eq, Ord)
 makeLenses ''Machine
@@ -48,6 +50,7 @@ makeMachine memory = Machine
   , _registers = M.fromList [ (r, 0) | r <- [0..7] ]
   , _memory = memory
   , _stack = []
+  , _tracing = False
   }
 
 -- traceMachine x = 
@@ -85,6 +88,7 @@ makeMachine memory = Machine
 runAll :: ProgrammedMachine ExecutionState
 runAll = do cip <- gets _ip
             opcode <- getLocation cip
+            traceMachine
             -- opcode' <- traceMachine opcode
             -- exState <- runStep opcode'
             exState <- runStep opcode
@@ -251,7 +255,7 @@ runStep 20 =
       else do let char = (inputs!!iIndex)
               putValue tgt char
               modify (\m -> m & inputIndex %~ (+ 1))
-              advanceIP 2
+              advanceIP 2     
               return Runnable
 
 runStep 21 = 
@@ -262,6 +266,51 @@ runStep _ =
      return Runnable
 
 
+traceMachine :: ProgrammedMachine ()
+traceMachine = do
+  isTracing <- gets _tracing
+  when isTracing
+    do  cip <- gets _ip
+        opcode <- getLocation cip
+        a <- getLocation (cip + 1)
+        b <- getLocation (cip + 2)
+        c <- getLocation (cip + 3)
+        let sa = show a
+        let sb = show b
+        let sc = show c
+        va <- getValue (cip + 1)
+        vb <- getValue (cip + 2)
+        vc <- getValue (cip + 3)
+        let sva = show va
+        let svb = show vb
+        let svc = show vc        
+        let traceText = 
+              case opcode of
+                0 -> ["halt"]
+                1 -> ["set", sa, sb, "*", sva, svb]
+                2 -> ["push", sa, "*", sva]
+                3 -> ["pop", sa, "*", sva]
+                4 -> ["eq", sa, sb, sc, "*", sva, svb, svc]
+                5 -> ["gt", sa, sb, sc, "*", sva, svb, svc]
+                6 -> ["jmp", sa, "*", sva]
+                7 -> ["jt", sa, sb, "*", sva, svb]
+                8 -> ["jf", sa, sb, "*", sva, svb]
+                9 -> ["add", sa, sb, sc, "*", sva, svb, svc]
+                10 -> ["mul", sa, sb, sc, "*", sva, svb, svc]
+                11 -> ["mod", sa, sb, sc, "*", sva, svb, svc]
+                12 -> ["and", sa, sb, sc, "*", sva, svb, svc]
+                13 -> ["or", sa, sb, sc, "*", sva, svb, svc]
+                14 -> ["not", sa, sb, "*", sva, svb]
+                15 -> ["rmem", sa, sb, "*", sva, svb]
+                16 -> ["wmem", sa, sb, "*", sva, svb]
+                17 -> ["call", sa, "*", sva]
+                18 -> ["ret"]
+                19 -> ["out", sa, "*", sva]
+                20 -> ["in", sa, "*", sva]
+                21 -> ["noop", sa, sb, sc, "*", sva, svb, svc]
+                _ -> ["illegal", sa, sb, sc, "*", sva, svb, svc]
+        tell $ fmap (fromIntegral . ord) (">> " ++ (show cip) ++ ": " ++ (intercalate " " traceText) ++ "<<")
+
 getValue :: Word16 -> ProgrammedMachine Word16
 getValue loc =
   do mem <- gets _memory