Fixed compilation issues
This commit is contained in:
parent
e0aa996db3
commit
4076899334
1 changed files with 14 additions and 16 deletions
|
@ -4,6 +4,7 @@ module Interpreter where
|
|||
import Data.Maybe (catMaybes)
|
||||
|
||||
data Instruction = TapeLeft | TapeRight | Add | Sub | Out | In | LoopStart | LoopEnd
|
||||
deriving (Eq, Show)
|
||||
|
||||
parseInstr :: Char -> Maybe Instruction
|
||||
parseInstr '<' = Just TapeLeft
|
||||
|
@ -16,7 +17,7 @@ parseInstr '[' = Just LoopStart
|
|||
parseInstr ']' = Just LoopEnd
|
||||
parseInstr _ = Nothing
|
||||
|
||||
newtype Byte = Byte Int
|
||||
newtype Byte = Byte Int deriving (Eq, Ord, Read, Show)
|
||||
chr :: Byte -> Char
|
||||
chr (Byte i) = toEnum i :: Char
|
||||
|
||||
|
@ -30,20 +31,18 @@ decr (Byte i) = Byte (i - 1)
|
|||
|
||||
type Tape = [Byte]
|
||||
type Program = [Instruction]
|
||||
type IP = Int
|
||||
type DP = Int
|
||||
|
||||
data ProgState = ProgState {
|
||||
tape :: Tape,
|
||||
dp :: DP,
|
||||
dp :: Int,
|
||||
output :: String,
|
||||
program :: Program,
|
||||
ip :: IP }
|
||||
ip :: Int }
|
||||
|
||||
toProgram :: String -> [Instruction]
|
||||
toProgram s = catMaybes $ fmap parseInstr s
|
||||
|
||||
tapeHelp :: Tape -> DP -> (Byte -> Byte) -> Tape
|
||||
tapeHelp :: Tape -> Int -> (Byte -> Byte) -> Tape
|
||||
tapeHelp (t:tt) 0 alter = alter t : tt
|
||||
tapeHelp (t:tt) dp alter = t : (tapeHelp tt dp alter)
|
||||
|
||||
|
@ -53,8 +52,8 @@ errorDesc :: Error -> String
|
|||
errorDesc NegTape = "ERROR: '<' not working. Cannot access negative tape positions."
|
||||
errorDesc LoopNoMatch = "ERROR: '[' or ']' not working. Matching parenthesis not found."
|
||||
|
||||
incrIP :: ProgState -> ProgState
|
||||
incrIP p = p { ip = ip p + 1 }
|
||||
incrInt :: ProgState -> ProgState
|
||||
incrInt p = p { ip = ip p + 1 }
|
||||
|
||||
execAdd :: ProgState -> Either Error ProgState
|
||||
execAdd p = Right p { tape = newTape }
|
||||
|
@ -78,13 +77,12 @@ execOut p = Right p { output = output p ++ [chr char]}
|
|||
|
||||
data WalkingDirection = Forward | Backward
|
||||
|
||||
|
||||
findMatching :: Program -> DP -> WalkingDirection -> Maybe IP
|
||||
findMatching :: Program -> Int -> WalkingDirection -> Maybe Int
|
||||
findMatching prg start wd = case wd of
|
||||
Forward -> fmHelper start 0 LoopEnd LoopStart (+1) (length prg)
|
||||
Backward -> fmHelper start 0 LoopStart LoopEnd (-1) 0
|
||||
where fmHelper :: IP -> Int -> Instruction -> Instruction -> (IP -> IP)
|
||||
-> Int -> Maybe DP
|
||||
Backward -> fmHelper start 0 LoopStart LoopEnd (-1+) 0
|
||||
where fmHelper :: Int -> Int -> Instruction -> Instruction -> (Int -> Int)
|
||||
-> Int -> Maybe Int
|
||||
fmHelper s acc b ob upd limit
|
||||
| acc == 0 && c == b = Just s
|
||||
| c == b = fmHelper (upd s) (acc - 1) b ob upd limit
|
||||
|
@ -94,11 +92,11 @@ findMatching prg start wd = case wd of
|
|||
where c = prg !! start
|
||||
|
||||
execLoopStart :: ProgState -> Either Error ProgState
|
||||
execLoopStart w = case newIP of
|
||||
execLoopStart w = case newInt of
|
||||
Just n -> Right w { ip = n }
|
||||
Nothing -> Left LoopNoMatch
|
||||
where jump = (tape w !! dp w) == 0
|
||||
where jump = (tape w !! dp w) == Byte 0
|
||||
posOrF = if jump then findMatching (program w) (ip w) Forward else Just $ ip w
|
||||
newIP = fmap (+1) posOrF
|
||||
newInt = fmap (+1) posOrF
|
||||
|
||||
|
||||
|
|
Loading…
Reference in a new issue