Using Vector for Program now
This commit is contained in:
parent
4b4e4a5fe6
commit
795d3e2c8b
3 changed files with 16 additions and 16 deletions
|
@ -4,7 +4,7 @@ cabal-version: 1.12
|
|||
--
|
||||
-- see: https://github.com/sol/hpack
|
||||
--
|
||||
-- hash: e8d6e868e77028a711ad97c90ec474cf2f05ac4dfa6d3ae02a43bf494e5f726c
|
||||
-- hash: 3277d5d4089bf8baf7def1286b1a2781377634c03875e81f8c3ded257e6454a1
|
||||
|
||||
name: drbrainfuck
|
||||
version: 0.1.0.0
|
||||
|
@ -34,9 +34,9 @@ library
|
|||
hs-source-dirs:
|
||||
src
|
||||
build-depends:
|
||||
array
|
||||
, base >=4.7 && <5
|
||||
base >=4.7 && <5
|
||||
, transformers
|
||||
, vector
|
||||
default-language: Haskell2010
|
||||
|
||||
executable drbrainfuck-exe
|
||||
|
@ -47,10 +47,10 @@ executable drbrainfuck-exe
|
|||
app
|
||||
ghc-options: -threaded -rtsopts -with-rtsopts=-N
|
||||
build-depends:
|
||||
array
|
||||
, base >=4.7 && <5
|
||||
base >=4.7 && <5
|
||||
, drbrainfuck
|
||||
, transformers
|
||||
, vector
|
||||
default-language: Haskell2010
|
||||
|
||||
test-suite drbrainfuck-test
|
||||
|
@ -62,8 +62,8 @@ test-suite drbrainfuck-test
|
|||
test
|
||||
ghc-options: -threaded -rtsopts -with-rtsopts=-N
|
||||
build-depends:
|
||||
array
|
||||
, base >=4.7 && <5
|
||||
base >=4.7 && <5
|
||||
, drbrainfuck
|
||||
, transformers
|
||||
, vector
|
||||
default-language: Haskell2010
|
||||
|
|
|
@ -22,7 +22,7 @@ description: Please see the README on GitHub at <https://github.com/gith
|
|||
dependencies:
|
||||
- base >= 4.7 && < 5
|
||||
- transformers
|
||||
- array
|
||||
- vector
|
||||
|
||||
library:
|
||||
source-dirs: src
|
||||
|
|
|
@ -3,7 +3,7 @@ module Interpreter where
|
|||
import Data.Maybe (catMaybes)
|
||||
import Debug.Trace
|
||||
import Control.Monad.Trans.State
|
||||
import Data.Array.IArray
|
||||
import qualified Data.Vector as V
|
||||
|
||||
data Instruction = TapeLeft | TapeRight | Add | Sub | Out | In | LoopStart |
|
||||
LoopEnd deriving (Eq, Show)
|
||||
|
@ -30,7 +30,7 @@ updateCell Add (Byte i) = Byte (i + 1)
|
|||
updateCell Sub (Byte i) = Byte (i - 1)
|
||||
|
||||
type Tape = [Byte]
|
||||
type Program = Array Int Instruction
|
||||
type Program = V.Vector Instruction
|
||||
|
||||
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 s = case progL of [] -> Nothing
|
||||
_ -> Just $ listArray (1, (length progL)) progL
|
||||
_ -> Just $ V.fromList progL
|
||||
where progL = catMaybes $ fmap parseInstr s
|
||||
|
||||
tapeHelp :: Tape -> Int -> (Byte -> Byte) -> Tape
|
||||
|
@ -89,7 +89,7 @@ findMatching prg par = fmHelper $ -1
|
|||
| c == oppos = fmHelper (acc - 1) $ next s
|
||||
| c == par = fmHelper (acc + 1) $ next s
|
||||
| otherwise = fmHelper acc $ next s
|
||||
where c = prg ! s
|
||||
where c = prg V.! s
|
||||
|
||||
execLoop :: Program -> Instruction -> Int -> State Memory Term
|
||||
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
|
||||
|
||||
execute :: Program -> Memory -> IO (Term, Memory)
|
||||
execute p = runStateT (runInstruction 1)
|
||||
execute p = runStateT $ runInstruction 0
|
||||
where runInstruction :: Int -> StateT Memory IO Term
|
||||
runInstruction ip = fmap checkDone (instrFor ip) >>= dbg >>= loopBack
|
||||
where loopBack (Next i) = runInstruction i
|
||||
|
@ -110,7 +110,7 @@ execute p = runStateT (runInstruction 1)
|
|||
return (a, s)
|
||||
|
||||
instrFor :: Int -> StateT Memory IO Term
|
||||
instrFor ip = case (p ! ip) of
|
||||
instrFor ip = case (p V.! ip) of
|
||||
TapeLeft -> toTerm ip . toStateT $ execTapeLeft
|
||||
TapeRight -> toTerm ip . toStateT $ execTapeRight
|
||||
Add -> toTerm ip . toStateT $ execUpdate Add
|
||||
|
@ -129,8 +129,8 @@ execute p = runStateT (runInstruction 1)
|
|||
|
||||
checkDone :: Term -> Term
|
||||
checkDone (Next x)
|
||||
| x == (snd . bounds $ p) + 1 = Done
|
||||
| otherwise = Next x
|
||||
| x == (V.length p) = Done
|
||||
| otherwise = Next x
|
||||
checkDone x = x
|
||||
|
||||
|
||||
|
|
Loading…
Reference in a new issue