Using Vector for Program now
This commit is contained in:
parent
4b4e4a5fe6
commit
795d3e2c8b
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue