Updated instruction types

src/Interpreter.hs

@@ -4,35 +4,37 @@ import Debug.Trace
 import Control.Monad.Trans.State
 import qualified Data.Vector as V
 
-data Instruction = TapeLeft | TapeRight | Add | Sub | Out | In | LoopStart |
-    LoopEnd deriving (Eq, Show)
+data UpdType = Add | Sub deriving (Eq, Show)
+data LoopType = Start | End deriving (Eq, Show)
+data Instruction = TapeLeft | TapeRight | Update UpdType | Out | In |
+    Loop LoopType deriving (Eq, Show)
 
 parseInstr :: Char -> Maybe Instruction
 parseInstr '<' = Just TapeLeft
 parseInstr '>' = Just TapeRight
-parseInstr '+' = Just Add
-parseInstr '-' = Just Sub
+parseInstr '+' = Just $ Update Add
+parseInstr '-' = Just $ Update Sub
 parseInstr '.' = Just Out
 parseInstr ',' = Just In
-parseInstr '[' = Just LoopStart
-parseInstr ']' = Just LoopEnd
+parseInstr '[' = Just $ Loop Start
+parseInstr ']' = Just $ Loop End
 parseInstr _ = Nothing
 
 newtype Byte = Byte Int deriving (Eq, Ord, Read, Show)
 chr :: Byte -> Char
 chr (Byte i) = toEnum i :: Char
 
-updateCell :: Instruction -> Byte -> Byte
+updateCell :: UpdType -> Byte -> Byte
 updateCell Add (Byte 255) = Byte 0
 updateCell Sub (Byte 0) = Byte 255
 updateCell Add (Byte i) = Byte (i + 1)
 updateCell Sub (Byte i) = Byte (i - 1)
 
 type Tape = V.Vector Byte
-type Program = V.Vector Instruction
-
 data Memory = Memory { tape :: Tape, dp :: Int } deriving (Show)
 
+type Program = V.Vector Instruction
+
 -- Consider putting IP in Termination output
 data Term = Next Int | Crash Error Int | Done deriving (Show)
 
@@ -50,7 +52,7 @@ errorDesc :: Error -> String
 errorDesc NegTape = "ERROR: '<' not working. Cannot access negative tape positions."
 errorDesc LoopNoMatch = "ERROR: '[' or ']' not working. Matching parenthesis not found."
 
-execUpdate :: Instruction -> State Memory (Maybe Error)
+execUpdate :: UpdType -> State Memory (Maybe Error)
 execUpdate i = state stateF
     where stateF p = (Nothing, p { tape = newTape p })
           newTape p = tapeHelp (tape p) (dp p) (updateCell i)
@@ -76,28 +78,28 @@ execOut :: StateT Memory IO (Maybe Error)
 execOut = StateT $ \p -> putChar (chr $ tape p V.! dp p) >>
                             (return (Nothing, p))
 
-findMatching :: Program -> Instruction -> Int -> Maybe Int
+findMatching :: Program -> LoopType -> Int -> Maybe Int
 findMatching prg par = fmHelper $ -1
     where (oppos, limit, next) = case par of
-            LoopStart -> (LoopEnd, length prg, (+1))
-            LoopEnd -> (LoopStart, 0, (-1+))
+            Start -> (End, length prg, (+1))
+            End -> (Start, 0, (-1+))
 
           fmHelper :: Int -> Int -> Maybe Int
           fmHelper acc s
-            | s == limit              = Nothing
-            | acc == 0 && c == oppos  = Just s
-            | c == oppos              = fmHelper (acc - 1) $ next s
-            | c == par                = fmHelper (acc + 1) $ next s
-            | otherwise               = fmHelper acc $ next s
+            | s == limit                  = Nothing
+            | acc == 0 && c == Loop oppos = Just s
+            | c == Loop oppos             = fmHelper (acc - 1) $ next s
+            | c == Loop par               = fmHelper (acc + 1) $ next s
+            | otherwise                   = fmHelper acc $ next s
             where c = prg V.! s
 
-execLoop :: Program -> Instruction -> Int -> State Memory Term
+execLoop :: Program -> LoopType -> Int -> State Memory Term
 execLoop p i ip = state $ \w -> case posOrF w of
                                   Just n -> (Next $ n + 1, w)
                                   Nothing -> (Crash LoopNoMatch ip, w)
     where posOrF ps = case ((tape ps V.! dp ps) == Byte 0, i) of
-                        (True, LoopStart) -> findMatching p i ip
-                        (False, LoopEnd) -> findMatching p i ip
+                        (True, Start) -> findMatching p i ip
+                        (False, End) -> findMatching p i ip
                         _ -> Just ip
 
 execute :: Program -> Memory -> IO (Term, Memory)
@@ -111,14 +113,12 @@ execute p = runStateT $ runInstruction 0
 
           instrFor :: Int -> StateT Memory IO Term
           instrFor ip = case (p V.! ip) of
+                            Update t -> toTerm ip . toStateT $ execUpdate t
+                            Loop t -> toStateT $ execLoop p t ip
                             TapeLeft -> toTerm ip . toStateT $ execTapeLeft
                             TapeRight -> toTerm ip . toStateT $ execTapeRight
-                            Add -> toTerm ip . toStateT $ execUpdate Add
-                            Sub -> toTerm ip . toStateT $ execUpdate Sub
                             In -> toTerm ip execIn
                             Out -> toTerm ip execOut
-                            LoopStart -> toStateT $ execLoop p LoopStart ip
-                            LoopEnd -> toStateT $ execLoop p LoopEnd ip
 
           toTerm ip = fmap termMem
                 where termMem Nothing  = Next $ ip + 1