Interpreter seems to work
This commit is contained in:
parent
7940a68150
commit
df9ac7f41c
1 changed files with 18 additions and 13 deletions
|
@ -3,6 +3,7 @@
|
||||||
module Interpreter where
|
module Interpreter where
|
||||||
import Data.Maybe (catMaybes)
|
import Data.Maybe (catMaybes)
|
||||||
import Control.Monad (liftM, ap)
|
import Control.Monad (liftM, ap)
|
||||||
|
import Debug.Trace
|
||||||
|
|
||||||
data Instruction = TapeLeft | TapeRight | Add | Sub | Out | In | LoopStart | LoopEnd
|
data Instruction = TapeLeft | TapeRight | Add | Sub | Out | In | LoopStart | LoopEnd
|
||||||
deriving (Eq, Show)
|
deriving (Eq, Show)
|
||||||
|
@ -59,7 +60,7 @@ toProgram s = catMaybes $ fmap parseInstr s
|
||||||
|
|
||||||
tapeHelp :: Tape -> Int -> (Byte -> Byte) -> Tape
|
tapeHelp :: Tape -> Int -> (Byte -> Byte) -> Tape
|
||||||
tapeHelp (t:tt) 0 alter = alter t : tt
|
tapeHelp (t:tt) 0 alter = alter t : tt
|
||||||
tapeHelp (t:tt) dp alter = t : (tapeHelp tt dp alter)
|
tapeHelp (t:tt) dp alter = t : (tapeHelp tt (dp-1) alter)
|
||||||
|
|
||||||
data Error = NegTape | LoopNoMatch deriving (Show)
|
data Error = NegTape | LoopNoMatch deriving (Show)
|
||||||
|
|
||||||
|
@ -83,38 +84,40 @@ execTapeLeft p = case dp p of 0 -> Crash NegTape
|
||||||
n -> Working p { dp = n - 1 }
|
n -> Working p { dp = n - 1 }
|
||||||
|
|
||||||
execTapeRight :: State -> Execution State
|
execTapeRight :: State -> Execution State
|
||||||
execTapeRight p = Working p { tape = if endOfType then tape p ++ [Byte 0] else tape p }
|
execTapeRight p = Working p { tape = if endOfType then tape p ++ [Byte 0] else tape p, dp = dp p + 1 }
|
||||||
where endOfType = dp p == length (tape p) - 1
|
where endOfType = dp p == length (tape p) - 1
|
||||||
|
|
||||||
execOut :: State -> Execution State
|
execOut :: State -> Execution State
|
||||||
execOut p = Working p { output = output p ++ [chr char]}
|
execOut p = Working p { output = output p ++ [chr char]}
|
||||||
where char = (tape p) !! dp p
|
where char = tape p !! dp p
|
||||||
|
|
||||||
data WalkingDirection = Forward | Backward
|
data WalkingDirection = Forward | Backward deriving (Eq, Show)
|
||||||
|
|
||||||
findMatching :: Program -> Int -> WalkingDirection -> Maybe Int
|
findMatching :: Program -> Int -> WalkingDirection -> Maybe Int
|
||||||
findMatching prg start wd = case wd of
|
findMatching prg start wd = case wd of
|
||||||
Forward -> fmHelper start 0 LoopEnd LoopStart (+1) (length prg)
|
Forward -> fmHelper start (-1) LoopEnd LoopStart (+1) (length prg)
|
||||||
Backward -> fmHelper start 0 LoopStart LoopEnd (-1+) 0
|
Backward -> fmHelper start (-1) LoopStart LoopEnd (-1+) 0
|
||||||
where fmHelper :: Int -> Int -> Instruction -> Instruction -> (Int -> Int)
|
where fmHelper :: Int -> Int -> Instruction -> Instruction -> (Int -> Int)
|
||||||
-> Int -> Maybe Int
|
-> Int -> Maybe Int
|
||||||
fmHelper s acc b ob upd limit
|
fmHelper s acc b ob upd limit
|
||||||
|
| s == limit = Nothing
|
||||||
| acc == 0 && c == b = Just s
|
| acc == 0 && c == b = Just s
|
||||||
| c == b = fmHelper (upd s) (acc - 1) b ob upd limit
|
| c == b = fmHelper (upd s) (acc - 1) b ob upd limit
|
||||||
| c == ob = fmHelper (upd s) (acc + 1) b ob upd limit
|
| c == ob = fmHelper (upd s) (acc + 1) b ob upd limit
|
||||||
| s == limit = Nothing
|
|
||||||
| otherwise = fmHelper (upd s) acc b ob upd limit
|
| otherwise = fmHelper (upd s) acc b ob upd limit
|
||||||
where c = prg !! start
|
where c = prg !! s
|
||||||
|
|
||||||
execLoop :: WalkingDirection -> State -> Execution State
|
execLoop :: WalkingDirection -> State -> Execution State
|
||||||
execLoop d w = case posOrF of
|
execLoop d w = case posOrF of
|
||||||
Just n -> Working w { ip = n }
|
Just n -> Working w { ip = n }
|
||||||
Nothing -> Crash LoopNoMatch
|
Nothing -> Crash LoopNoMatch
|
||||||
where jump = (tape w !! dp w) == Byte 0
|
where jump
|
||||||
|
| (tape w !! dp w) == Byte 0 = d == Forward
|
||||||
|
| otherwise = d == Backward
|
||||||
posOrF = if jump then findMatching (program w) (ip w) d else Just $ ip w
|
posOrF = if jump then findMatching (program w) (ip w) d else Just $ ip w
|
||||||
|
|
||||||
execute :: State -> Execution State
|
execute :: State -> Execution State
|
||||||
execute w = runInstr w >>= checkDone >>= execute
|
execute w = (traceShowId $ runInstr w) >>= checkDone >>= execute
|
||||||
where instrFor w = case (program w !! ip w) of
|
where instrFor w = case (program w !! ip w) of
|
||||||
TapeLeft -> execTapeLeft
|
TapeLeft -> execTapeLeft
|
||||||
TapeRight -> execTapeRight
|
TapeRight -> execTapeRight
|
||||||
|
@ -129,8 +132,9 @@ execute w = runInstr w >>= checkDone >>= execute
|
||||||
|
|
||||||
checkDone :: State -> Execution State
|
checkDone :: State -> Execution State
|
||||||
checkDone ps
|
checkDone ps
|
||||||
| length (program ps) == ip ps = Done $ output ps
|
| (length . program) ps == newIP = Done $ output ps
|
||||||
| otherwise = Working $ incrIP ps
|
| otherwise = Working $ ps { ip = newIP }
|
||||||
|
where newIP = ip ps + 1
|
||||||
|
|
||||||
initState :: Program -> State
|
initState :: Program -> State
|
||||||
initState p = State {
|
initState p = State {
|
||||||
|
@ -141,4 +145,5 @@ initState p = State {
|
||||||
ip = 0}
|
ip = 0}
|
||||||
|
|
||||||
run :: String -> Execution State
|
run :: String -> Execution State
|
||||||
run = execute . initState . catMaybes . fmap parseInstr
|
run "" = Done ""
|
||||||
|
run s = execute . initState . catMaybes . fmap parseInstr $ s
|
||||||
|
|
Loading…
Reference in a new issue