Skip to content

Instantly share code, notes, and snippets.

@the-bokya
Last active March 7, 2023 16:21
Show Gist options
  • Save the-bokya/a1f3c1d77ea5070356737e597e80b47f to your computer and use it in GitHub Desktop.
Save the-bokya/a1f3c1d77ea5070356737e597e80b47f to your computer and use it in GitHub Desktop.
A Brainfuck interpreter in Haskell. (Note: It lacks the input ',' command). Pipe in the Brainfuck code through STDIN.
import Data.Char
-- Cmd is the tree containing the commands in sequence.
data Cmd = Cmd Char Cmd | Loop Cmd Cmd | Empty deriving Show
-- Brain is the main datatype that is processed throughout the program.
-- It has a strip of numbers with a pointer to point to the index on it
-- making it a Turing Machine. It also carries with it the output to be
-- piped out to standard output.
data Brain = Brain [Int] Int String deriving Show
-- Mod functions
safeMod :: Int -> Int -> Int
safeMod x n = if x >= 0 then mod x n else safeMod (x + n) n
bytify :: Int -> Int
bytify x = safeMod x 256
stripify :: Int -> Int
stripify x = safeMod x 30000
brainChar :: Brain -> String
brainChar (Brain arr ptr out) = (show $ arr !! ptr) ++ " "
-- Functions to convert input to tree
cmdify :: String -> Cmd
cmdify [] = Empty
cmdify (x:xs) = case x of
'[' -> getLoop xs 1
_ -> Cmd x (cmdify xs)
getLoop :: String -> Int -> Cmd
getLoop (x:xs) n = getLoop' (x:xs) n ""
where
getLoop' (x:xs) 1 out = case x of
'[' -> getLoop' xs 2 (out ++ [x])
']' -> Loop (cmdify out) (cmdify xs)
_ -> getLoop' xs 1 (out ++ [x])
getLoop' (x:xs) n out = case x of
'[' -> getLoop' xs (n+1) (out ++ [x])
']' -> getLoop' xs (n-1) (out ++ [x])
_ -> getLoop' xs n (out ++ [x])
-- Functions to change state of the brain
incr :: Brain -> Brain
incr (Brain arr ptr out) = Brain (changeArr arr ptr (+1)) ptr out
decr :: Brain -> Brain
decr (Brain arr ptr out) = Brain (changeArr arr ptr (\x -> x-1)) ptr out
up :: Brain -> Brain
up (Brain arr ptr out) = Brain arr (stripify (ptr + 1)) out
down :: Brain -> Brain
down (Brain arr ptr out) = Brain arr (stripify (ptr - 1)) out
-- Processing lists and text
getOut :: Brain -> String
getOut (Brain _ _ out) = out
giveOut :: Brain -> Brain
giveOut (Brain arr ptr out) = Brain arr ptr (out ++ [chr $ arr !! ptr])
changeArr :: [Int] -> Int -> (Int -> Int) -> [Int]
changeArr arr ptr f = begin ++ [bytify $ f elem] ++ end
where
splitArr = splitAt (ptr+1) arr
begin = init (fst splitArr)
elem = last (fst splitArr)
end = snd splitArr
-- Functions to interpret the commands
interpret :: Cmd -> Brain -> Brain
interpret (Cmd x Empty) brain = operate brain x
interpret (Empty) brain = brain
interpret (Cmd x y) brain = interpret y (operate brain x)
interpret (Loop v w) brain = interpret w (loop v brain)
loop :: Cmd -> Brain -> Brain
loop v (Brain arr ptr out) = if arr !! ptr == 0 then (Brain arr ptr out) else loop v (interpret v (Brain arr ptr out))
operate :: Brain -> Char -> Brain
operate brain x = case x of
'+' -> incr brain
'-' -> decr brain
'<' -> down brain
'>' -> up brain
'.' -> giveOut brain
_ -> brain
main = do
input <- getContents
putStr $ getOut $ interpret (cmdify input) (Brain [0 | x <- [1..30000]] 0 [])
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment