From 02c382ca137b6a28c5becc719c6722c584111b57 Mon Sep 17 00:00:00 2001
From: "Claudio Maggioni (maggicl)" <maggicl@kolabnow.ch>
Date: Sun, 8 Nov 2020 16:25:29 +0100
Subject: [PATCH] Tape is now an immutable Vector

---
 src/Interpreter.hs | 21 +++++++++++----------
 1 file changed, 11 insertions(+), 10 deletions(-)

diff --git a/src/Interpreter.hs b/src/Interpreter.hs
index da8320e..8562b4b 100644
--- a/src/Interpreter.hs
+++ b/src/Interpreter.hs
@@ -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: