secret
Created

  • Download Gist
Brainfuck.hs
Haskell
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70
import Control.Monad.State
import Data.List(splitAt, findIndex)
 
type Stack = (Int, [Char], [Char])
type BFState = State Stack Stack
 
-- Increments a character.
incChar :: Char -> Char
incChar = toEnum . (+1) . fromEnum
 
-- Decrement a character. Fails if the input is '\00'
decChar :: Char -> Char
decChar = toEnum . flip (-) 1 . fromEnum
 
-- Updates a list element, I feel like I've forgotten about a prelude function for this.
updateElem :: (a -> a) -> [a] -> Int -> [a]
updateElem f xs n = front ++ back
where (front, (b:bs)) = splitAt n xs
back = (f b):bs
 
-- Runs a Brainfuck program using the state monad and a pre-supplied input list.
processProgram :: String -> String -> BFState
processProgram (c:cs) input = do
case c of
'>' -> modify (\(p, stack, output) -> (p+1, stack, output)) >> processProgram cs input
'<' -> modify (\(p, stack, output) -> (p-1, stack, output)) >> processProgram cs input
'+' -> modify (\(p, stack, output) -> (p, updateElem incChar stack p, output))
>> processProgram cs input
'-' -> modify (\(p, stack, output) -> (p, updateElem decChar stack p, output))
>> processProgram cs input
'.' -> modify (\(p, stack, output) -> (p, stack, (stack !! p):output))
>> processProgram cs input
',' -> modify (\(p, stack, output) -> (p, updateElem (\_ -> head input) stack p, output))
>> processProgram cs (tail input)
'[' -> do -- some horrible recursive State monad usage to evaluate the loop
let mEnclosed = findClosingBrace cs
case mEnclosed of
Nothing -> fail "Unmatched opening brace"
Just (between, after) -> do
state@(p, stack, _) <- get
if fromEnum (stack !! p) == 0
then processProgram after input
else do
put $ evalState (processProgram between input) state
processProgram (c:cs) input
']' -> fail "Unmatched closing brace"
processProgram [] _ = get
-- Finds the sub-program between the opening '[' and its corrseponding ']'.
-- This opening '[' is assumed to have already been removed from the start of the list
findClosingBrace :: String -> Maybe (String, String)
findClosingBrace program = do
nextClose <- findIndex (== ']') program
let (between, (_:after)) = splitAt nextClose program
numOpen = length $ filter (== '[') between
numClosed = length $ filter (== ']') between
if numOpen - numClosed == 0
then return (between, after)
else do
(between', after') <- findClosingBrace after
return (between ++ "]" ++ between', after')
 
runProgram :: String -> String -> IO ()
runProgram prog input = putStrLn
$ reverse
$ (\(_,_,c) -> c)
$ flip evalState (0, replicate 300 '\00', []) -- Fixed stack size of 300
$ processProgram prog input
test = runProgram "++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>." ""

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.