diff --git a/src/Interpreter.hs b/src/Interpreter.hs index cb060be..9309d75 100644 --- a/src/Interpreter.hs +++ b/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 -incr (Byte 255) = Byte 0 -incr (Byte i) = Byte (i + 1) - -decr :: Byte -> Byte -decr (Byte 0) = Byte 255 -decr (Byte i) = Byte (i - 1) +updateCell :: Instruction -> 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 = [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 -execAdd p = Working p { tape = newTape } - where newTape = tapeHelp (tape p) (dp p) incr - -execSub :: State -> Execution State -execSub p = Working p { tape = newTape } - where newTape = tapeHelp (tape p) (dp p) decr +execUpdate :: Instruction -> State -> Execution State +execUpdate i p = Working p { tape = newTape } + where newTape = tapeHelp (tape p) (dp p) (updateCell i) 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 } - where endOfType = dp p == length (tape p) - 1 +execTapeRight p = Working p { tape = tape p ++ newTape, dp = dp 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 -findMatching prg start wd = case wd of - 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 - | otherwise = fmHelper (upd s) acc b ob upd limit + fmHelper :: Int -> Int -> Maybe Int + fmHelper acc s + | s == limit = Nothing + | acc == 0 && c == toFind = Just s + | c == toFind = fmHelper (acc - 1) $ next s + | c == oppos = fmHelper (acc + 1) $ next s + | otherwise = fmHelper acc $ next s 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 = d == Forward - | otherwise = d == Backward - posOrF = if jump then findMatching (program w) (ip w) d else Just $ ip w +execLoop :: Instruction -> State -> Execution State +execLoop d w = case posOrF of Just n -> Working w { ip = n } + Nothing -> Crash LoopNoMatch + where isZero = (tape w !! dp w) == Byte 0 + jump = case d of LoopStart -> isZero + LoopEnd -> not isZero + posOrF = case jump of True -> findMatching (program w) d (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 - TapeRight -> execTapeRight - Add -> execAdd - Sub -> execSub - Out -> execOut - LoopStart -> execLoop Forward - LoopEnd -> execLoop Backward + TapeLeft -> execTapeLeft + TapeRight -> execTapeRight + Add -> execUpdate Add + Sub -> execUpdate Sub + Out -> execOut + l -> execLoop l runInstr :: State -> Execution State runInstr w = instrFor w $ w