maggicl
/
drbrainfuck.hs
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Fix bug in loop

This commit is contained in:
Claudio Maggioni (maggicl) 2020-11-06 21:37:31 +01:00
parent 8bd02f88ef
commit fe51f06439
1 changed files with 11 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
src/Interpreter.hs
View File

@ -90,22 +90,21 @@ findMatching prg par = fmHelper $ -1
where c = prg !! s
execLoop :: Program -> Instruction -> Int -> State Memory Term
execLoop p d ip = state $ \w -> case posOrF w of Just n -> (Next n, w)
Nothing -> (Crash LoopNoMatch ip, w)
execLoop p d ip = state $ \w -> case posOrF w of Just n -> (Next $ n + 1, w)
_ -> (Crash LoopNoMatch ip, w)
where isZero w = (tape w !! dp w) == Byte 0
jump = case d of LoopStart -> isZero
LoopEnd -> not . isZero
posOrF w = case jump w of True -> findMatching p d ip
_ -> Just ip
shouldJump LoopStart = isZero
shouldJump LoopEnd = not . isZero
posOrF w = case shouldJump d w of True -> findMatching p d ip
_ -> Just ip
execute :: Program -> Memory -> IO (Term, Memory)
execute p = runStateT (runInstruction 0)
where runInstruction :: Int -> StateT Memory IO Term
runInstruction ip = fmap checkDone (instrFor ip) >>= print >>= loopBack
runInstruction ip = fmap checkDone (instrFor ip) >>= dbg >>= loopBack
where loopBack (Next i) = runInstruction i
loopBack x = return x
print :: Term -> StateT Memory IO Term
print a = StateT $ \s -> return $ traceShowId (a, s)
dbg a = StateT $ \s -> return $ traceShowId (a, s)
instrFor :: Int -> StateT Memory IO Term
instrFor ip = case (p !! ip) of
@ -115,14 +114,15 @@ execute p = runStateT (runInstruction 0)
Sub -> toTerm ip . toStateT $ execUpdate Sub
In -> toTerm ip execIn
Out -> toTerm ip execOut
l -> toStateT $ execLoop p l ip
LoopStart -> toStateT $ execLoop p LoopStart ip
LoopEnd -> toStateT $ execLoop p LoopEnd ip
toTerm ip = fmap termMem
where termMem Nothing = Next $ ip + 1
termMem (Just e) = Crash e ip
toStateT :: (Monad m) => State s a -> StateT s m a
toStateT x = StateT $ (\s -> return . runState x $ s)
toStateT x = StateT $ return . (runState x)
checkDone :: Term -> Term
checkDone (Next x) = if x == (length p) then Done else Next x