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