diff --git a/src/Interpreter.hs b/src/Interpreter.hs index 9309d75..2e2d525 100644 --- a/src/Interpreter.hs +++ b/src/Interpreter.hs @@ -35,15 +35,14 @@ type Program = [Instruction] data State = State { tape :: Tape, dp :: Int, - output :: String, program :: Program, ip :: Int } deriving (Show) -data Execution a = Working a | Crash Error | Done String deriving (Show) +data Execution a = Working a | Crash Error | Done deriving (Show) instance Monad Execution where (Crash e) >>= _ = Crash e - (Done t) >>= _ = Done t + Done >>= _ = Done (Working d) >>= f = f d instance Functor Execution where @@ -69,35 +68,39 @@ errorDesc LoopNoMatch = "ERROR: '[' or ']' not working. Matching parenthesis not incrIP :: State -> State incrIP p = p { ip = ip p + 1 } -execUpdate :: Instruction -> State -> Execution State -execUpdate i p = Working p { tape = newTape } +execUpdate :: Instruction -> State -> State +execUpdate i p = 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 = tape p ++ newTape, dp = dp p + 1 } +execTapeRight :: State -> State +execTapeRight p = 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 +execIn :: State -> IO (Execution State) +execIn p = do chr <- getChar + tp <- pure $ fromEnum chr + return $ Working p { tape = tapeHelp (tape p) (dp p) (\_ -> Byte tp) } + +execOut :: State -> IO (Execution State) +execOut p = putChar (chr (tape p !! dp p)) >> (return . Working $ p) 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 prg par = fmHelper $ -1 + where (oppos, limit, next) = case par of + LoopStart -> (LoopEnd, length prg, (+1)) + LoopEnd -> (LoopStart, 0, (-1+)) 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 + | 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 where c = prg !! s @@ -110,35 +113,40 @@ execLoop d w = case posOrF of Just n -> Working w { ip = n } posOrF = case jump of True -> findMatching (program w) d (ip w) _ -> Just $ ip w -execute :: State -> Execution State -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 -> execUpdate Add - Sub -> execUpdate Sub +execute :: State -> IO (Execution State) +execute w = runInstr w >>= andThen + where instrFor :: State -> State -> IO (Execution State) + instrFor w = case (program w !! ip w) of + TapeLeft -> return . execTapeLeft + TapeRight -> return . Working . execTapeRight + Add -> return . Working . (execUpdate Add) + Sub -> return . Working . (execUpdate Sub) + In -> execIn Out -> execOut - l -> execLoop l + l -> return . execLoop l - runInstr :: State -> Execution State + andThen :: Execution State -> IO (Execution State) + andThen s = case s >>= checkDone of + Working s -> execute s + t -> return t + + runInstr :: State -> IO (Execution State) runInstr w = instrFor w $ w checkDone :: State -> Execution State checkDone ps - | (length . program) ps == newIP = Done $ output ps + | (length . program) ps == newIP = Done | otherwise = Working $ ps { ip = newIP } where newIP = ip ps + 1 + initState :: Program -> State initState p = State { tape = [Byte 0], dp = 0, - output = "", program = p, ip = 0} -run :: String -> Execution State -run "" = Done "" -run s = execute . initState . catMaybes . fmap parseInstr $ s +run :: String -> IO (Execution State) +run s = case catMaybes . fmap parseInstr $ s of [] -> return Done + l -> execute . initState $ l