Implemented OUT and reimplemented IN with IO

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