Interpreter seems to work

src/Interpreter.hs

@@ -3,6 +3,7 @@
 module Interpreter where
 import Data.Maybe (catMaybes)
 import Control.Monad (liftM, ap)
+import Debug.Trace
 
 data Instruction = TapeLeft | TapeRight | Add | Sub | Out | In | LoopStart | LoopEnd
     deriving (Eq, Show)
@@ -59,7 +60,7 @@ toProgram s = catMaybes $ fmap parseInstr s
 
 tapeHelp :: Tape -> Int -> (Byte -> Byte) -> Tape
 tapeHelp (t:tt) 0 alter = alter t : tt
-tapeHelp (t:tt) dp alter = t : (tapeHelp tt dp alter)
+tapeHelp (t:tt) dp alter = t : (tapeHelp tt (dp-1) alter)
 
 data Error = NegTape | LoopNoMatch deriving (Show)
 
@@ -83,38 +84,40 @@ execTapeLeft p = case dp p of 0 -> Crash NegTape
                               n -> Working p { dp = n - 1 }
 
 execTapeRight :: State -> Execution State
-execTapeRight p = Working p { tape = if endOfType then tape p ++ [Byte 0] else tape p }
+execTapeRight p = Working p { tape = if endOfType then tape p ++ [Byte 0] else tape p, dp = dp p + 1 }
     where endOfType = dp p == length (tape p) - 1
 
 execOut :: State -> Execution State
 execOut p = Working p { output = output p ++ [chr char]}
-    where char = (tape p) !! dp p
+    where char = tape p !! dp p
 
-data WalkingDirection = Forward | Backward
+data WalkingDirection = Forward | Backward deriving (Eq, Show)
 
 findMatching :: Program -> Int -> WalkingDirection -> Maybe Int
 findMatching prg start wd = case wd of
-                 Forward -> fmHelper start 0 LoopEnd LoopStart (+1) (length prg)
-                 Backward -> fmHelper start 0 LoopStart LoopEnd (-1+) 0
+                 Forward -> fmHelper start (-1) LoopEnd LoopStart (+1) (length prg)
+                 Backward -> fmHelper start (-1) LoopStart LoopEnd (-1+) 0
         where fmHelper :: Int -> Int -> Instruction -> Instruction -> (Int -> Int)
                 -> Int -> Maybe Int
               fmHelper s acc b ob upd limit
+                | s == limit         = Nothing
                 | acc == 0 && c == b = Just s
                 | c == b             = fmHelper (upd s) (acc - 1) b ob upd limit
                 | c == ob            = fmHelper (upd s) (acc + 1) b ob upd limit
-                | s == limit         = Nothing
                 | otherwise          = fmHelper (upd s) acc b ob upd limit
-                where c = prg !! start
+                where c = prg !! s
 
 execLoop :: WalkingDirection -> State -> Execution State
 execLoop d w = case posOrF of
             Just n -> Working w { ip = n }
             Nothing -> Crash LoopNoMatch
-    where jump = (tape w !! dp w) == Byte 0
+    where jump
+            | (tape w !! dp w) == Byte 0 = d == Forward
+            | otherwise                  = d == Backward
           posOrF = if jump then findMatching (program w) (ip w) d else Just $ ip w
 
 execute :: State -> Execution State
-execute w = runInstr w >>= checkDone >>= execute
+execute w = (traceShowId $ runInstr w) >>= checkDone >>= execute
     where instrFor w = case (program w !! ip w) of
                 TapeLeft -> execTapeLeft
                 TapeRight -> execTapeRight
@@ -129,8 +132,9 @@ execute w = runInstr w >>= checkDone >>= execute
 
           checkDone :: State -> Execution State
           checkDone ps
-            | length (program ps) == ip ps = Done $ output ps
-            | otherwise                    = Working $ incrIP ps
+            | (length . program) ps == newIP = Done $ output ps
+            | otherwise                      = Working $ ps { ip = newIP }
+            where newIP = ip ps + 1
 
 initState :: Program -> State
 initState p = State {
@@ -141,4 +145,5 @@ initState p = State {
     ip = 0}
 
 run :: String -> Execution State
-run = execute . initState . catMaybes . fmap parseInstr
+run "" = Done ""
+run s = execute . initState . catMaybes . fmap parseInstr $ s