Done teleporter code

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

diff --git a/src/SynacorEngine.hs b/src/SynacorEngine.hs
index cbd5e047c0792ade68966ec4d92788923218e446..757bd5f011ea9dbc31434176010031d6b9306db0 100644 (file)
--- a/src/SynacorEngine.hs
+++ b/src/SynacorEngine.hs
@@ -40,7 +40,7 @@ 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
@@ -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
+          registers <- gets _registers
+          let regVals = intercalate "; " $ fmap show $ M.elems registers
+          stack <- gets _stack
+          let stackVals = intercalate "; " $ fmap show $ take 10 stack
+          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 =