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.

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.