Using Vector for Program now

This commit is contained in:
Claudio Maggioni (maggicl) 2020-11-08 14:38:10 +01:00
parent 4b4e4a5fe6
commit 795d3e2c8b
3 changed files with 16 additions and 16 deletions

View File

@ -4,7 +4,7 @@ cabal-version: 1.12
-- --
-- see: https://github.com/sol/hpack -- see: https://github.com/sol/hpack
-- --
-- hash: e8d6e868e77028a711ad97c90ec474cf2f05ac4dfa6d3ae02a43bf494e5f726c -- hash: 3277d5d4089bf8baf7def1286b1a2781377634c03875e81f8c3ded257e6454a1
name: drbrainfuck name: drbrainfuck
version: 0.1.0.0 version: 0.1.0.0
@ -34,9 +34,9 @@ library
hs-source-dirs: hs-source-dirs:
src src
build-depends: build-depends:
array base >=4.7 && <5
, base >=4.7 && <5
, transformers , transformers
, vector
default-language: Haskell2010 default-language: Haskell2010
executable drbrainfuck-exe executable drbrainfuck-exe
@ -47,10 +47,10 @@ executable drbrainfuck-exe
app app
ghc-options: -threaded -rtsopts -with-rtsopts=-N ghc-options: -threaded -rtsopts -with-rtsopts=-N
build-depends: build-depends:
array base >=4.7 && <5
, base >=4.7 && <5
, drbrainfuck , drbrainfuck
, transformers , transformers
, vector
default-language: Haskell2010 default-language: Haskell2010
test-suite drbrainfuck-test test-suite drbrainfuck-test
@ -62,8 +62,8 @@ test-suite drbrainfuck-test
test test
ghc-options: -threaded -rtsopts -with-rtsopts=-N ghc-options: -threaded -rtsopts -with-rtsopts=-N
build-depends: build-depends:
array base >=4.7 && <5
, base >=4.7 && <5
, drbrainfuck , drbrainfuck
, transformers , transformers
, vector
default-language: Haskell2010 default-language: Haskell2010

View File

@ -22,7 +22,7 @@ description: Please see the README on GitHub at <https://github.com/gith
dependencies: dependencies:
- base >= 4.7 && < 5 - base >= 4.7 && < 5
- transformers - transformers
- array - vector
library: library:
source-dirs: src source-dirs: src

View File

@ -3,7 +3,7 @@ module Interpreter where
import Data.Maybe (catMaybes) import Data.Maybe (catMaybes)
import Debug.Trace import Debug.Trace
import Control.Monad.Trans.State import Control.Monad.Trans.State
import Data.Array.IArray import qualified Data.Vector as V
data Instruction = TapeLeft | TapeRight | Add | Sub | Out | In | LoopStart | data Instruction = TapeLeft | TapeRight | Add | Sub | Out | In | LoopStart |
LoopEnd deriving (Eq, Show) LoopEnd deriving (Eq, Show)
@ -30,7 +30,7 @@ updateCell Add (Byte i) = Byte (i + 1)
updateCell Sub (Byte i) = Byte (i - 1) updateCell Sub (Byte i) = Byte (i - 1)
type Tape = [Byte] type Tape = [Byte]
type Program = Array Int Instruction type Program = V.Vector Instruction
data Memory = Memory { tape :: Tape, dp :: Int } deriving (Show) data Memory = Memory { tape :: Tape, dp :: Int } deriving (Show)
@ -39,7 +39,7 @@ data Term = Next Int | Crash Error Int | Done deriving (Show)
toProgram :: String -> Maybe Program toProgram :: String -> Maybe Program
toProgram s = case progL of [] -> Nothing toProgram s = case progL of [] -> Nothing
_ -> Just $ listArray (1, (length progL)) progL _ -> Just $ V.fromList progL
where progL = catMaybes $ fmap parseInstr s where progL = catMaybes $ fmap parseInstr s
tapeHelp :: Tape -> Int -> (Byte -> Byte) -> Tape tapeHelp :: Tape -> Int -> (Byte -> Byte) -> Tape
@ -89,7 +89,7 @@ findMatching prg par = fmHelper $ -1
| c == oppos = fmHelper (acc - 1) $ next s | c == oppos = fmHelper (acc - 1) $ next s
| c == par = fmHelper (acc + 1) $ next s | c == par = fmHelper (acc + 1) $ next s
| otherwise = fmHelper acc $ next s | otherwise = fmHelper acc $ next s
where c = prg ! s where c = prg V.! s
execLoop :: Program -> Instruction -> Int -> State Memory Term execLoop :: Program -> Instruction -> Int -> State Memory Term
execLoop p i ip = state $ \w -> case posOrF w of execLoop p i ip = state $ \w -> case posOrF w of
@ -101,7 +101,7 @@ execLoop p i ip = state $ \w -> case posOrF w of
_ -> Just ip _ -> Just ip
execute :: Program -> Memory -> IO (Term, Memory) execute :: Program -> Memory -> IO (Term, Memory)
execute p = runStateT (runInstruction 1) execute p = runStateT $ runInstruction 0
where runInstruction :: Int -> StateT Memory IO Term where runInstruction :: Int -> StateT Memory IO Term
runInstruction ip = fmap checkDone (instrFor ip) >>= dbg >>= loopBack runInstruction ip = fmap checkDone (instrFor ip) >>= dbg >>= loopBack
where loopBack (Next i) = runInstruction i where loopBack (Next i) = runInstruction i
@ -110,7 +110,7 @@ execute p = runStateT (runInstruction 1)
return (a, s) return (a, s)
instrFor :: Int -> StateT Memory IO Term instrFor :: Int -> StateT Memory IO Term
instrFor ip = case (p ! ip) of instrFor ip = case (p V.! ip) of
TapeLeft -> toTerm ip . toStateT $ execTapeLeft TapeLeft -> toTerm ip . toStateT $ execTapeLeft
TapeRight -> toTerm ip . toStateT $ execTapeRight TapeRight -> toTerm ip . toStateT $ execTapeRight
Add -> toTerm ip . toStateT $ execUpdate Add Add -> toTerm ip . toStateT $ execUpdate Add
@ -129,8 +129,8 @@ execute p = runStateT (runInstruction 1)
checkDone :: Term -> Term checkDone :: Term -> Term
checkDone (Next x) checkDone (Next x)
| x == (snd . bounds $ p) + 1 = Done | x == (V.length p) = Done
| otherwise = Next x | otherwise = Next x
checkDone x = x checkDone x = x