diff --git a/src/Interpreter.hs b/src/Interpreter.hs index 8562b4b..acba84e 100644 --- a/src/Interpreter.hs +++ b/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