Rewritten loops and update tape operations

src/Interpreter.hs

@@ -23,13 +23,11 @@ newtype Byte = Byte Int deriving (Eq, Ord, Read, Show)
 chr :: Byte -> Char
 chr (Byte i) = toEnum i :: Char
 
-incr :: Byte -> Byte
+updateCell :: Instruction -> Byte -> Byte
-incr (Byte 255) = Byte 0
+updateCell Add (Byte 255) = Byte 0
-incr (Byte i) = Byte (i + 1)
+updateCell Sub (Byte 0) = Byte 255
-
+updateCell Add (Byte i) = Byte (i + 1)
-decr :: Byte -> Byte
+updateCell Sub (Byte i) = Byte (i - 1)
-decr (Byte 0) = Byte 255
-decr (Byte i) = Byte (i - 1)
 
 type Tape = [Byte]
 type Program = [Instruction]
@@ -55,7 +53,7 @@ instance Applicative Execution where
     pure = return
     (<*>) = ap
 
-toProgram :: String -> [Instruction]
+toProgram :: String -> Program
 toProgram s = catMaybes $ fmap parseInstr s
 
 tapeHelp :: Tape -> Int -> (Byte -> Byte) -> Tape
@@ -71,61 +69,58 @@ errorDesc LoopNoMatch = "ERROR: '[' or ']' not working. Matching parenthesis not
 incrIP :: State -> State
 incrIP p = p { ip = ip p + 1 }
 
-execAdd :: State -> Execution State
+execUpdate :: Instruction -> State -> Execution State
-execAdd p = Working p { tape = newTape }
+execUpdate i p = Working p { tape = newTape }
-    where newTape = tapeHelp (tape p) (dp p) incr
+    where newTape = tapeHelp (tape p) (dp p) (updateCell i)
-
-execSub :: State -> Execution State
-execSub p = Working p { tape = newTape }
-    where newTape = tapeHelp (tape p) (dp p) decr
 
 execTapeLeft :: State -> Execution State
 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, dp = dp p + 1 }
+execTapeRight p = Working p { tape = tape p ++ newTape, dp = dp p + 1 }
-    where endOfType = dp p == length (tape p) - 1
+    where newTape = case dp p == length (tape p) - 1 of True -> [Byte 0]
+                                                        _ -> []
 
 execOut :: State -> Execution State
 execOut p = Working p { output = output p ++ [chr char]}
     where char = tape p !! dp p
 
-data WalkingDirection = Forward | Backward deriving (Eq, Show)
+findMatching :: Program -> Instruction -> Int -> Maybe Int
+findMatching prg toFind = fmHelper $ -1
+        where (oppos, limit, next) = case toFind of
+                LoopEnd -> (LoopStart, length prg, (+1))
+                LoopStart -> (LoopEnd, 0, (-1+))
 
-findMatching :: Program -> Int -> WalkingDirection -> Maybe Int
+              fmHelper :: Int -> Int -> Maybe Int
-findMatching prg start wd = case wd of
+              fmHelper acc s
-                 Forward -> fmHelper start (-1) LoopEnd LoopStart (+1) (length prg)
+                | s == limit              = Nothing
-                 Backward -> fmHelper start (-1) LoopStart LoopEnd (-1+) 0
+                | acc == 0 && c == toFind = Just s
-        where fmHelper :: Int -> Int -> Instruction -> Instruction -> (Int -> Int)
+                | c == toFind             = fmHelper (acc - 1) $ next s
-                -> Int -> Maybe Int
+                | c == oppos              = fmHelper (acc + 1) $ next s
-              fmHelper s acc b ob upd limit
+                | otherwise               = fmHelper acc $ next s
-                | 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
-                | otherwise          = fmHelper (upd s) acc b ob upd limit
                 where c = prg !! s
 
-execLoop :: WalkingDirection -> State -> Execution State
+execLoop :: Instruction -> State -> Execution State
-execLoop d w = case posOrF of
+execLoop d w = case posOrF of Just n -> Working w { ip = n }
-            Just n -> Working w { ip = n }
+                              Nothing -> Crash LoopNoMatch
-            Nothing -> Crash LoopNoMatch
+    where isZero = (tape w !! dp w) == Byte 0
-    where jump
+          jump = case d of LoopStart -> isZero
-            | (tape w !! dp w) == Byte 0 = d == Forward
+                           LoopEnd -> not isZero
-            | otherwise                  = d == Backward
+          posOrF = case jump of True -> findMatching (program w) d (ip w)
-          posOrF = if jump then findMatching (program w) (ip w) d else Just $ ip w
+                                _ -> Just $ ip w
 
 execute :: State -> Execution State
-execute w = (traceShowId $ runInstr w) >>= checkDone >>= execute
+execute w = do ran <- (traceShowId $ runInstr w)
+               newStatus <- checkDone ran
+               execute newStatus
     where instrFor w = case (program w !! ip w) of
-                TapeLeft -> execTapeLeft
+                            TapeLeft -> execTapeLeft
-                TapeRight -> execTapeRight
+                            TapeRight -> execTapeRight
-                Add -> execAdd
+                            Add -> execUpdate Add
-                Sub -> execSub
+                            Sub -> execUpdate Sub
-                Out -> execOut
+                            Out -> execOut
-                LoopStart -> execLoop Forward
+                            l -> execLoop l
-                LoopEnd -> execLoop Backward
 
           runInstr :: State -> Execution State
           runInstr w = instrFor w $ w