Tape is now an immutable Vector
This commit is contained in:
parent
795d3e2c8b
commit
02c382ca13
|
@ -1,5 +1,4 @@
|
|||
module Interpreter where
|
||||
-- vim: set ts=4 sw=4 et tw=80:
|
||||
import Data.Maybe (catMaybes)
|
||||
import Debug.Trace
|
||||
import Control.Monad.Trans.State
|
||||
|
@ -29,7 +28,7 @@ updateCell Sub (Byte 0) = Byte 255
|
|||
updateCell Add (Byte i) = Byte (i + 1)
|
||||
updateCell Sub (Byte i) = Byte (i - 1)
|
||||
|
||||
type Tape = [Byte]
|
||||
type Tape = V.Vector Byte
|
||||
type Program = V.Vector Instruction
|
||||
|
||||
data Memory = Memory { tape :: Tape, dp :: Int } deriving (Show)
|
||||
|
@ -43,8 +42,7 @@ toProgram s = case progL of [] -> Nothing
|
|||
where progL = 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-1) alter)
|
||||
tapeHelp t dp upd = t V.// [(dp, upd $ t V.! dp)]
|
||||
|
||||
data Error = NegTape | LoopNoMatch deriving (Show)
|
||||
|
||||
|
@ -63,9 +61,10 @@ execTapeLeft = state $ \p -> case dp p of 0 -> (Just NegTape, p)
|
|||
|
||||
execTapeRight :: State Memory (Maybe Error)
|
||||
execTapeRight = state $ \p -> (Nothing, newMem p)
|
||||
where newMem p = p { tape = tape p ++ newTape p, dp = dp p + 1 }
|
||||
newTape p = case dp p == length (tape p) - 1 of True -> [Byte 0]
|
||||
_ -> []
|
||||
where newMem p = p { tape = newTape p, dp = dp p + 1 }
|
||||
newTape p
|
||||
| dp p == V.length (tape p) - 1 = V.snoc (tape p) $ Byte 0
|
||||
| otherwise = tape p
|
||||
|
||||
execIn :: StateT Memory IO (Maybe Error)
|
||||
execIn = StateT $ \p -> do chr <- getChar
|
||||
|
@ -74,7 +73,8 @@ execIn = StateT $ \p -> do chr <- getChar
|
|||
where newTape tp p = p { tape = tapeHelp (tape p) (dp p) (\_ -> Byte tp) }
|
||||
|
||||
execOut :: StateT Memory IO (Maybe Error)
|
||||
execOut = StateT $ \p -> putChar (chr (tape p !! dp p)) >> (return (Nothing, p))
|
||||
execOut = StateT $ \p -> putChar (chr $ tape p V.! dp p) >>
|
||||
(return (Nothing, p))
|
||||
|
||||
findMatching :: Program -> Instruction -> Int -> Maybe Int
|
||||
findMatching prg par = fmHelper $ -1
|
||||
|
@ -95,7 +95,7 @@ execLoop :: Program -> Instruction -> 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 !! dp ps) == Byte 0, i) of
|
||||
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
|
||||
_ -> Just ip
|
||||
|
@ -135,8 +135,9 @@ execute p = runStateT $ runInstruction 0
|
|||
|
||||
|
||||
initMemory :: Memory
|
||||
initMemory = Memory { tape = [Byte 0], dp = 0 }
|
||||
initMemory = Memory { tape = V.singleton $ Byte 0, dp = 0 }
|
||||
|
||||
run :: String -> IO ((Term, Memory))
|
||||
run str = case toProgram str of Nothing -> return (Done, initMemory)
|
||||
Just pp -> execute pp initMemory
|
||||
-- vim: set ts=4 sw=4 et tw=80:
|
||||
|
|
Loading…
Reference in New Issue