Skip to content

Instantly share code, notes, and snippets.

@mgaut72

mgaut72/runBF_1_line_main.hs

Last active December 31, 2015 11:48
Show Gist options
  • Save mgaut72/7981739 to your computer and use it in GitHub Desktop.
Save mgaut72/7981739 to your computer and use it in GitHub Desktop.
Download ZIP
Brainfuck Interpreter
Raw
runBF_1_line_main.hs
import System.Environment (getArgs)
import Control.Applicative
import Data.Word (Word8)
import Data.ByteString.Internal (c2w, w2c)
main :: IO ()
main = head <$> getArgs >>= readFile >>= run . start
type Zipper a = ([a], [a])
forward :: Zipper a -> Zipper a
forward (x:xs, bs) = (xs, x:bs)
backward :: Zipper a -> Zipper a
backward (xs, b:bs) = (b:xs, bs)
start :: [Char] -> (Zipper Char, Zipper Word8)
start prog = ((prog, []), (repeat 0, []))
run :: (Zipper Char, Zipper Word8) -> IO ()
run (([],_),_) = return ()
run state = doOne state >>= run
doOne :: (Zipper Char, Zipper Word8) -> IO (Zipper Char, Zipper Word8)
doOne (instrs@('>':_, _), tape)
= return (forward instrs, forward tape)
doOne (instrs@('<':_, _), tape)
= return (forward instrs, backward tape)
doOne (instrs@('+':_, _), (x:ft, bt))
= return (forward instrs, ((x+1):ft, bt))
doOne (instrs@('-':_, _), (x:ft, bt))
= return (forward instrs, ((x-1):ft, bt))
doOne (instrs@('[':_, _), tape@(x:_, _))
| x /= 0 = return (forward instrs, tape)
| otherwise = return (jumpForward instrs, tape)
doOne (instrs@(']':_, _), tape@(x:_, _))
| x /= 0 = return (jumpBack instrs, tape)
| otherwise = return (forward instrs, tape)
doOne (instrs@('.':_, _), tape@(x:_, _))
= putChar (w2c x) >> return (forward instrs, tape)
doOne (instrs@(',':_, _), (x:ft, bt))
= do
newVal <- getChar
return (forward instrs, (c2w newVal:ft, bt))
doOne (instrs, tape) = return (forward instrs, tape)
jumpForward :: Zipper Char -> Zipper Char
jumpForward instrs@(']':_, _) = forward instrs
jumpForward instrs = jumpForward . forward $ instrs
jumpBack :: Zipper Char -> Zipper Char
jumpBack instrs@(_, '[':_) = backward instrs
jumpBack instrs = jumpBack . backward $ instrs
Raw
runBF_as_patterns.hs
import System.Environment (getArgs)
import System.IO
import Control.Applicative
import Data.Word (Word8)
import Data.List
import qualified Data.ByteString.Internal as BS (c2w, w2c)
main :: IO ()
main = do
srcName <- head <$> getArgs
srch <- openFile srcName ReadMode
source <- readSrc srch
run . start . tokenize $ source
hClose srch
readSrc :: Handle -> IO String
readSrc h = do
ineof <- hIsEOF h
if ineof
then return ""
else do
srcLine <- hGetLine h
(srcLine ++) <$> readSrc h
-- The 8 legal brainfuck commands
data Instr = IncPtr | DecPtr | IncVal | DecVal | PutVal
| GetVal | While | Elihw
deriving (Eq)
-- this definition of show allows for showing a list of instructions
-- such that it is the same as the source code, but with comments
-- and whitespace removed
instance Show Instr where
show IncPtr = ">"
show DecPtr = "<"
show IncVal = "+"
show DecVal = "-"
show PutVal = "."
show GetVal = ","
show While = "["
show Elihw = "]"
showList = (++) . concatMap show
tokenize :: String -> [Instr]
tokenize [] = []
tokenize ('>':xs) = IncPtr:tokenize xs
tokenize ('<':xs) = DecPtr:tokenize xs
tokenize ('+':xs) = IncVal:tokenize xs
tokenize ('-':xs) = DecVal:tokenize xs
tokenize ('.':xs) = PutVal:tokenize xs
tokenize (',':xs) = GetVal:tokenize xs
tokenize ('[':xs) = While:tokenize xs
tokenize (']':xs) = Elihw:tokenize xs
tokenize (_:xs) = tokenize xs
type Zipper a = ([a], [a])
forward :: Zipper a -> Zipper a
forward (x:xs, bs) = (xs, x:bs)
backward :: Zipper a -> Zipper a
backward (xs, b:bs) = (b:xs, bs)
start :: [Instr] -> (Zipper Instr, Zipper Word8)
start prog = ((prog, []), (repeat 0, []))
run :: (Zipper Instr, Zipper Word8) -> IO ()
run (([],_),_) = return ()
run state = doOne state >>= run
doOne :: (Zipper Instr, Zipper Word8) -> IO (Zipper Instr, Zipper Word8)
doOne (instrs@(IncPtr:_, _), tape)
= return (forward instrs, forward tape)
doOne (instrs@(DecPtr:_, _), tape)
= return (forward instrs, backward tape)
doOne (instrs@(IncVal:_, _), (x:ft, bt))
= return (forward instrs, ((x+1):ft, bt))
doOne (instrs@(DecVal:_, _), (x:ft, bt))
= return (forward instrs, ((x-1):ft, bt))
doOne (instrs@(While:_, _), tape@(x:_, _))
| x /= 0 = return (forward instrs, tape)
| otherwise = return (jumpForward instrs, tape)
doOne (instrs@(Elihw:_, _), tape@(x:_, _))
| x /= 0 = return (jumpBack instrs, tape)
| otherwise = return (forward instrs, tape)
doOne (instrs@(PutVal:_, _), tape@(x:_, _))
= do
putChar (BS.w2c x)
return (forward instrs, tape)
doOne (instrs@(GetVal:_, _), (x:ft, bt))
= do
newVal <- getChar
return (forward instrs, (BS.c2w newVal:ft, bt))
jumpForward :: Zipper Instr -> Zipper Instr
jumpForward (Elihw:xs, ys) = (xs, Elihw:ys)
jumpForward (x:xs, ys) = jumpForward (xs, x:ys)
jumpBack :: Zipper Instr -> Zipper Instr
jumpBack (xs, While:ys) = (While:xs, ys)
jumpBack (xs, y:ys) = jumpBack (y:xs, ys)
Raw
runBF_first.hs
import System.Environment (getArgs)
import System.IO
import Control.Applicative
import Data.Word (Word8)
import qualified Data.ByteString.Internal as BS (c2w, w2c)
main :: IO ()
main = do
srcName <- head <$> getArgs
srch <- openFile srcName ReadMode
source <- readSrc srch
run (return (start (tokenize source)))
hClose srch
readSrc :: Handle -> IO (String)
readSrc h = do
ineof <- hIsEOF h
if ineof
then return ""
else do
srcLine <- hGetLine h
(srcLine ++) <$> readSrc h
-- The 8 legal brainfuck commands
data Instruction = IncPtr | DecPtr | IncVal | DecVal | PutVal
| GetVal | While | Elihw
deriving (Eq)
instance Show Instruction where
show IncPtr = ">"
show DecPtr = "<"
show IncVal = "+"
show DecVal = "-"
show PutVal = "."
show GetVal = ","
show While = "["
show Elihw = "]"
tokenize :: String -> [Instruction]
tokenize [] = []
tokenize ('>':xs) = IncPtr:(tokenize xs)
tokenize ('<':xs) = DecPtr:(tokenize xs)
tokenize ('+':xs) = IncVal:(tokenize xs)
tokenize ('-':xs) = DecVal:(tokenize xs)
tokenize ('.':xs) = PutVal:(tokenize xs)
tokenize (',':xs) = GetVal:(tokenize xs)
tokenize ('[':xs) = While:(tokenize xs)
tokenize (']':xs) = Elihw:(tokenize xs)
tokenize (_:xs) = tokenize xs
type BrainZipper = ([Instruction], [Instruction])
type TapeZipper = ([Word8], [Word8])
start :: [Instruction] -> (BrainZipper, TapeZipper)
start prog = ((prog, []), ( take 300 (repeat 0), []))
run :: IO (BrainZipper, TapeZipper) -> IO (BrainZipper, TapeZipper)
run prog = do
((x,y), tape) <- prog >>= doOne
if null x
then return ((x,y), tape)
else run (return ((x,y), tape))
doOne :: (BrainZipper, TapeZipper) -> IO (BrainZipper, TapeZipper)
doOne (((cmd:prog), back), ((x:forward), y:backward))
| cmd == IncPtr = return ((prog, cmd:back), (forward, x:y:backward))
| cmd == DecPtr = return ((prog, cmd:back), (y:x:forward, backward))
| cmd == IncVal = return ((prog, cmd:back), ((x+1):forward, y:backward))
| cmd == DecVal = return ((prog, cmd:back), ((x-1):forward, y:backward))
| cmd == While = if x /= 0
then return ((prog, cmd:back), (x:forward, y:backward))
else return (jumpForward (cmd:prog, back), (x:forward, y:backward))
| cmd == Elihw = if x /= 0
then return (jumpBack (cmd:prog, back), (x:forward, y:backward))
else return ((prog, cmd:back), (x:forward, y:backward))
| cmd == PutVal = do
putChar (BS.w2c x)
return ((prog, cmd:back), (x:forward, y:backward))
| cmd == GetVal = do
newVal <- getChar
return ((prog, cmd:back), ((BS.c2w newVal):forward, y:backward))
doOne (((cmd:prog), []), ((x:forward), []))
| cmd == IncPtr = return ((prog, cmd:[]), (forward, x:[]))
| cmd == IncVal = return ((prog, cmd:[]), ((x+1):forward, []))
| cmd == DecVal = return ((prog, cmd:[]), ((x-1):forward, []))
| cmd == While = if x /= 0
then return ((prog, cmd:[]), (x:forward, []))
else return (jumpForward (cmd:prog, []), (x:forward, []))
| cmd == Elihw = if x /= 0
then return (jumpBack (cmd:prog, []), (x:forward, []))
else return ((prog, cmd:[]), (x:forward, []))
| cmd == PutVal = do
putChar (BS.w2c x)
return ((prog, cmd:[]), (x:forward, []))
| cmd == GetVal = do
newVal <- getChar
return ((prog, cmd:[]), ((BS.c2w newVal):forward, []))
doOne (((cmd:prog), back), ((x:forward), []))
| cmd == IncPtr = return ((prog, cmd:back), (forward, x:[]))
| cmd == IncVal = return ((prog, cmd:back), ((x+1):forward, []))
| cmd == DecVal = return ((prog, cmd:back), ((x-1):forward, []))
| cmd == While = if x /= 0
then return ((prog, cmd:back), (x:forward, []))
else return (jumpForward (cmd:prog, back), (x:forward, []))
| cmd == Elihw = if x /= 0
then return (jumpBack (cmd:prog, back), (x:forward, []))
else return ((prog, cmd:back), (x:forward, []))
| cmd == PutVal = do
putChar (BS.w2c x)
return ((prog, cmd:back), (x:forward, []))
| cmd == GetVal = do
newVal <- getChar
return ((prog, cmd:back), ((BS.c2w newVal):forward, []))
jumpForward :: BrainZipper -> BrainZipper
jumpForward (Elihw:xs, ys) = (xs, Elihw:ys)
jumpForward (x:xs, ys) = jumpForward (xs, x:ys)
jumpBack :: BrainZipper -> BrainZipper
jumpBack (xs, While:ys) = (While:xs, ys)
jumpBack (xs, y:ys) = jumpBack (y:xs, ys)
Raw
runBF_fix_pattern_matching.hs
import System.Environment (getArgs)
import System.IO
import Control.Applicative
import Data.Word (Word8)
import qualified Data.ByteString.Internal as BS (c2w, w2c)
main :: IO ()
main = do
srcName <- head <$> getArgs
srch <- openFile srcName ReadMode
source <- readSrc srch
run (return (start (tokenize source)))
hClose srch
readSrc :: Handle -> IO (String)
readSrc h = do
ineof <- hIsEOF h
if ineof
then return ""
else do
srcLine <- hGetLine h
(srcLine ++) <$> readSrc h
-- The 8 legal brainfuck commands
data Instruction = IncPtr | DecPtr | IncVal | DecVal | PutVal
| GetVal | While | Elihw
deriving (Eq)
instance Show Instruction where
show IncPtr = ">"
show DecPtr = "<"
show IncVal = "+"
show DecVal = "-"
show PutVal = "."
show GetVal = ","
show While = "["
show Elihw = "]"
tokenize :: String -> [Instruction]
tokenize [] = []
tokenize ('>':xs) = IncPtr:(tokenize xs)
tokenize ('<':xs) = DecPtr:(tokenize xs)
tokenize ('+':xs) = IncVal:(tokenize xs)
tokenize ('-':xs) = DecVal:(tokenize xs)
tokenize ('.':xs) = PutVal:(tokenize xs)
tokenize (',':xs) = GetVal:(tokenize xs)
tokenize ('[':xs) = While:(tokenize xs)
tokenize (']':xs) = Elihw:(tokenize xs)
tokenize (_:xs) = tokenize xs
type BrainZipper = ([Instruction], [Instruction])
type TapeZipper = ([Word8], [Word8])
start :: [Instruction] -> (BrainZipper, TapeZipper)
start prog = ((prog, []), ( take 300 (repeat 0), []))
run :: IO (BrainZipper, TapeZipper) -> IO (BrainZipper, TapeZipper)
run prog = do
((x,y), tape) <- prog >>= doOne
if null x
then return ((x,y), tape)
else run (return ((x,y), tape))
doOne :: (BrainZipper, TapeZipper) -> IO (BrainZipper, TapeZipper)
doOne ((IncPtr:toDo, done), ((x:ft), bt))
= return ((toDo, IncPtr:done), (ft, x:bt))
doOne ((DecPtr:toDo, done), (ft, x:bt))
= return ((toDo, DecPtr:done), (x:ft, bt))
doOne ((IncVal:toDo, done), (x:ft, bt))
= return ((toDo, IncVal:done), ((x+1):ft, bt))
doOne ((DecVal:toDo, done), (x:ft, bt))
= return ((toDo, DecVal:done), ((x-1):ft, bt))
doOne ((While:toDo, done), (x:ft, bt))
= if x /= 0
then return ((toDo, While:done), (x:ft, bt))
else return (jumpForward (While:toDo, done), (x:ft, bt))
doOne ((Elihw:toDo, done), (x:ft, bt))
= if x /= 0
then return (jumpBack (Elihw:toDo, done), (x:ft, bt))
else return ((toDo, Elihw:done), (x:ft, bt))
doOne ((PutVal:toDo, done), (x:ft,bt))
= do
putChar (BS.w2c x)
return ((toDo, PutVal:done), (x:ft, bt))
doOne ((GetVal:toDo, done), (x:ft, bt))
= do
newVal <- getChar
return ((toDo, GetVal:done), ((BS.c2w newVal):ft, bt))
jumpForward :: BrainZipper -> BrainZipper
jumpForward (Elihw:xs, ys) = (xs, Elihw:ys)
jumpForward (x:xs, ys) = jumpForward (xs, x:ys)
jumpBack :: BrainZipper -> BrainZipper
jumpBack (xs, While:ys) = (While:xs, ys)
jumpBack (xs, y:ys) = jumpBack (y:xs, ys)
Raw
runBF_no_Instr_type.hs
import System.Environment (getArgs)
import System.IO
import Control.Applicative
import Data.Word (Word8)
import Data.List
import qualified Data.ByteString.Internal as BS (c2w, w2c)
main :: IO ()
main = do
srcName <- head <$> getArgs
srch <- openFile srcName ReadMode
source <- readSrc srch
run . start $ source
hClose srch
readSrc :: Handle -> IO String
readSrc h = do
ineof <- hIsEOF h
if ineof
then return ""
else do
srcLine <- hGetLine h
(srcLine ++) <$> readSrc h
type Zipper a = ([a], [a])
forward :: Zipper a -> Zipper a
forward (x:xs, bs) = (xs, x:bs)
backward :: Zipper a -> Zipper a
backward (xs, b:bs) = (b:xs, bs)
start :: [Char] -> (Zipper Char, Zipper Word8)
start prog = ((prog, []), (repeat 0, []))
run :: (Zipper Char, Zipper Word8) -> IO ()
run (([],_),_) = return ()
run state = doOne state >>= run
doOne :: (Zipper Char, Zipper Word8) -> IO (Zipper Char, Zipper Word8)
doOne (instrs@('>':_, _), tape)
= return (forward instrs, forward tape)
doOne (instrs@('<':_, _), tape)
= return (forward instrs, backward tape)
doOne (instrs@('+':_, _), (x:ft, bt))
= return (forward instrs, ((x+1):ft, bt))
doOne (instrs@('-':_, _), (x:ft, bt))
= return (forward instrs, ((x-1):ft, bt))
doOne (instrs@('[':_, _), tape@(x:_, _))
| x /= 0 = return (forward instrs, tape)
| otherwise = return (jumpForward instrs, tape)
doOne (instrs@(']':_, _), tape@(x:_, _))
| x /= 0 = return (jumpBack instrs, tape)
| otherwise = return (forward instrs, tape)
doOne (instrs@('.':_, _), tape@(x:_, _))
= do
putChar (BS.w2c x)
return (forward instrs, tape)
doOne (instrs@(',':_, _), (x:ft, bt))
= do
newVal <- getChar
return (forward instrs, (BS.c2w newVal:ft, bt))
doOne (instrs, tape) = return (forward instrs, tape)
jumpForward :: Zipper Char -> Zipper Char
jumpForward instrs@(']':_, _) = forward instrs
jumpForward instrs = jumpForward . forward $ instrs
jumpBack :: Zipper Char -> Zipper Char
jumpBack instrs@(_, '[':_) = backward instrs
jumpBack instrs = jumpBack . backward $ instrs
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment