Haskell Brainfuck DSL

A few months ago, I thought about using the C preprocessor to write a set of macros to make writing Brainfuck programs simpler by letting you use mnemonics for common operations. I quickly found that it wasn't such a great idea, and stopped.

But today, I saw my previous work, and then thought, "Hey, maybe I could write it in Haskell instead." So I did.


{- Brainfuck.hs - A sort of DSL to ease writing of Brainfuck programs. -}

module Brainfuck where
import Control.Monad.Writer
import Data.Char
import Prelude hiding (read, show)

type Brainfuck = Writer [Char] ()

{- Basic Brainfuck commands. -}

nop :: Brainfuck
nop = tell ""

inc :: Brainfuck
inc = tell "+"

dec :: Brainfuck
dec = tell "-"

next :: Brainfuck
next = tell ">"

prev :: Brainfuck
prev = tell "<"

read :: Brainfuck
read = tell ","

show :: Brainfuck
show = tell "."

loop :: Brainfuck
loop = tell "["

end :: Brainfuck
end = tell "]"

{- Predifined Brainfuck sequences. -}

-- Clears the current cell.
clear :: Brainfuck
clear = do { loop; dec; end; }

-- Destructively moves the contents of the current cell into the next.
move :: Brainfuck
move = do
  {
    next; clear; prev;
    loop;
      dec; next; inc; prev;
    end;
  }

-- Destructively adds the contents of the next cell into the current.
addNext :: Brainfuck
addNext = do { next; loop; dec; prev; inc; next; end; }

-- Destructively subtracts the contents of the next cell from the current.
subNext :: Brainfuck
subNext = do { next; loop; dec; prev; dec; next; end; }

{- More complex Brainfuck-sequence-producing functions. -}

-- Adds n to the current cell.
add :: Int -> Brainfuck
add n
  | n <= 0    = tell ""
  | otherwise = inc >> add (n - 1)

-- Subtracts n from the current cell.
sub :: Int -> Brainfuck
sub n
  | n <= 0    = tell ""
  | otherwise = dec >> sub (n - 1)

-- Puts the string onto the screen. Somewhat intelligent in that it keeps track
-- of the previous character, and either adds/subtracts enough to get to the
-- next character, or just clears the cell and adds enough to get there,
-- whichever produces less code.
puts :: String -> Brainfuck
puts = putsIter 0
  where
    putsIter _ "" = nop
    putsIter v (s:ss) = do
      -- The character to print as an integer.
      let v' = ord s
      -- The difference between the last character and this one.
      let d  = v' - v
      -- If the difference is less than the character to print,
      if (abs d) < v'
        -- Then either add or subtract our way to the next character.
        then if d > 0
               then add d
               else sub (negate d)
        -- If the difference is larger, just clear and add.
        else do clear
                add v'
      show
      putsIter v' ss

{- Other functions. -}

-- Writes a Brainfuck sequence to stdout.
compile :: Brainfuck -> IO ()
compile = putStrLn . execWriter

I particularly like the puts function. Not as good as a hand-optimized Brainfuck message, but still pretty good.

OP, you made me found my old ABC interpreter I wrote when I was 12. I still haven't finished it.

main :: IO()
main =  do args <- getArgs
           putStrLn "The ABC interpreter, version 0.1"
           putStrLn "Type `:c' for ABC commands, `:q' to quit"
           if (not (null args) && (args !! 0) == "-exts")
             then putStrLn "Type `:e' for extended commands" else return ()
           if (not (null args) && (args !! 0) == "-exts")
             then repl 1 else repl 0

repl    :: Int -> IO ()
repl n  =  do putStr "abc> "
              hFlush stdout
              s <- getLine
              case s of
                ":c" -> cmds
                ":e" -> cmdsx
                _    -> abc n s       
              if (s /= ":q") then repl n else return ()

cmds :: IO ()
cmds =  putStrLn commands

commands :: [Char]
commands =  ("a - Increment the accumulator\nb - Decrement the accumulator\nc - Output the accumulator\n"               ++
             "d - Invert accumulator\nn - Set accumulator to 0\n"                                                       ++
--           "r - Set accumulator to a random number between 0 and accumulator\n"                                       ++
             "$ - Toggle ASCII output mode. When on, the c instruction prints the accumulator as an ascii character.\n" ++
             "l - Loop back to the beginning of the program. Accumulator and ASCII mode does not reset.\n"              ++
             "; - Debug. Print out accumulator as a number")

cmdsx :: IO ()
cmdsx =  putStrLn commandsx

commandsx :: [Char]
commandsx =  (". - Double the accumulator\n"    ++
              "j - Loop back to the beginning of the program if the accumulator is 0")

abc'                :: Int -> Bool -> [Char] -> [Char] -> Int -> IO ()
abc' _ _ _ []     _ = putStrLn ""
abc' a t i (x:xs) n = case x of
       'a' -> abc' (a + 1) t i xs n
       'b' -> abc' (a - 1) t i xs n
       'c' -> if t then (putStr[(toEnum a)]) >> abc' a t i xs n
                   else (putStr (show   a) ) >> abc' a t i xs n
       'd' -> abc' (0 - a) t i xs n
       '$' -> abc' a (not t) i xs n
       'n' -> abc' 0       t i xs n
       'l' -> abc' a       t i i  n
       ';' -> (putStr "accumulator: ")       >> (print a) >> abc' a t i xs n
       '.' -> abc' (2 * a) t i xs n
       'j' -> abc' a       t i (if (a == 0) then i else xs) n
       _   -> return ()

abc :: Int -> [Char] -> IO ()
abc n s = abc' 0 False s s n

One thinks you've missed the point of Brainfuck, OP. At least write your macro system in Brainfuck.

>>3
Or he could write a macro system for Brainfuck in the DSL; if he only posts the compiled Brainfuck version, no-one will know the difference (except the code will be a bit long.)

There's already a macro system for brainfuck, but at least use:

loop x = tell "[" >> x >> tell "]"

Also, the Monoid instance for [Char] has O(n) mappend. Using Dual and then reverse . getDual . runWriter might help. Or you could use Data.Sequence.

>>5
arguing about effeciency in Haskell
IHBT

fail