Brainf*ck-to-C compiler

compile.hs

{-# LANGUAGE OverloadedStrings #-}

codeChar :: Char -> String
codeChar c = case c of
    '+' -> "++*p;"
    '-' -> "--*p;"
    '>' -> "++p;"
    '<' -> "--p;"
    '.' -> "fputc(*p, mode ? f : stdout);"
    '|' -> "fflush(mode ? f : stdout);"
    ',' -> "*p = fgetc(mode ? f : stdin);"
    '[' -> "while (*p) {"
    ']' -> "}"
    '!' -> "mode = !mode;"
    '#' -> unlines
           [ "if (mode) {"
           , "if (f) fclose(f);"
           , "f = fopen(p, \"rw\");"
           , "}"
           ]
    'e' -> "if (*p) return *p;"
    _   -> ""

-- Simple refiner which removes simple redundant expressions like "+-" or "><"
-- Doesn't work with more complicated expressions like "> + < + > -"
refine :: String -> String
refine s = case s of
    ('+':'-':xs) -> refine xs
    ('-':'+':xs) -> refine xs
    ('>':'<':xs) -> refine xs
    ('<':'>':xs) -> refine xs
    ('[':']':xs) -> 'e':refine xs -- 'e' is a hidden instruction to exit the
                                  -- program in case of blatent infinite loop.
                                  -- This can be used to break/exit the program
                                  -- arbitrarily
    (x:xs)       -> x:refine xs
    []           -> []

-- This just refines the code until it can't be refined anymore.
optimize :: String -> String
optimize s
    | s == sv = sv
    | otherwise = optimize sv
    where sv = refine s

compile :: String -> String
compile = (++) ( unlines
               [ "#include <stdio.h>"
               , "int main() {"
               , "char m[30000];"
               , "char *p = m;"
               , "FILE *f = NULL;"
               , "char mode = 0;"
               ]
               )
        . (++ "return 0;\n}")
        . unlines
        . map codeChar
        . optimize
        . filter (`elem` "+-><.,[]!#")

main = interact compile