Ломаем хаскелем Brainfuck

Немного о bfc

Brainfuck — очень глупый язык. Там есть лента из 30к ячеек, по байту каждая. Команды bfc это:

• Передвижение по ленте влево и вправо (символы < и >)
• Увеличение и уменьшение значения в ячейке (символы + и -)
• Ввод и вывод текущей ячейки (символы . и ,)
• И цикл while, который продолжается пока значение в текущей ячейке не ноль. [ и ] это начало и конец цикла соответственно

Программировать на bfc сложно. Но, как известно, любую проблему можно решить добавлением слоя абстракции (кроме проблемы большого количества абстракций).

Начнём, как обычно, с малого

Основные определения

Основные конструкции попросту один в один переносим в хаскель

data Instr = Inc | Dec | Shl | Shr | In | Out | Loop [Instr] deriving (Eq, Show)
--            +     -     <     >     ,    .     [...]

Интерпретатор bfc приводить не буду, их написано огромное множество. Да и написал я его тяп-ляп только для того, чтобы не нужно было из REPL-а каждый раз выходить.

Главной абстракцией над инструкциями будет кодогенератор:

type CodeGen a = Writer [Instr] a

Выглядит страшновато, но по сути CodeGen просто возвращает список инструкций. Если кодогенераторов несколько, то они вызываются по-очереди, а инструкции склеиваются в большой список.

Основа основ в bfc это смещения. Чтобы не писать их вручную, создаём функции rshift и lshift:

rshift :: Int -> CodeGen ()
rshift x | x > 0 = tell $ replicate   x  Shr
         | x < 0 = tell $ replicate (-x) Shl
         | otherwise = return ()

lshift :: Int -> CodeGen ()
lshift x = rshift (-x)

Если смещение положительное, повторяем x раз смещение вправо, если отрицательное, то повторяем -x раз смещение влево, иначе не делаем ничего. Смещение влево на x это то же самое, что смещение вправо на -x

Добавим удобный способ зациклить код:

loop :: CodeGen () -> CodeGen ()
loop body = tell $ [Loop (execWriter body)]

Внутри мы получаем список инструкций body, вставляем их в Loop, и с помощью tell делаем из этого новый CodeGen ()

Напишем инструкцию reset. Она будет обнулять значение в текущей ячейке.
Алгоритм обнуления прост: пока значение не ноль, уменьшаем его. В bfc это записывается так: [-]. А в наших функциях это запишется так:

reset :: CodeGen ()
reset = loop $ tell [Dec]

Осталось построить ещё несколько функций, и можно строить следующий уровень абстракции. А функции которые нам нужны это move-ы. Они будут помогать в перемещении и копировании значения.

Отвлечёмся немного от хаскеля и посмотрим как это делается в bfc. Для того, чтобы перенести значение из текущей ячейки в соседнюю мы пишем [->+<]. Читать этот код следует так:
пока в ячейке что-то есть, отними единицу, перейди в соседнюю ячейку, добавь туда единицу и вернись обратно.
Этот код будет работать не совсем верно, если в соседней ячейке уже что-то есть, поэтому перед началом переноса нужно её обнулить. Точно так же можно переносить сразу в две или вообще N ячеек. Выглядит код аналогично: пока есть значение в ячейке отнимаем единицу, проходим по всем ячейкам в которые мы переносим эту и добавляем туда по единице. После возвращаемся назад.

Сначала напишем простую версию без обнуления:

moveN' :: From Int -> To [Int] -> CodeGen ()
moveN' (From src) (To dsts) = do
  rshift src -- Переходим к ячейке-источнику
  loop $ do
    tell $ [Dec] -- Однимаем единицу
    lshift src   -- Возвращаемся к базовому адресу

    -- Проходимся по всем ячейкам и добавляем туда единицу
    forM_ dsts $ \dst -> do
      rshift dst   -- Смещение
      tell $ [Inc] -- Инкремент
      lshift dst   -- Возвращение к базовому адресу

    rshift src -- Возвращение к ячейке-источнику

  lshift src -- Возвращение к базовому адресу

А теперь на её основе более сложную:

moveN :: From Int -> To [Int] -> CodeGen ()
moveN (From src) (To dsts) = do
  -- Обнуляем dst ячейки
  forM_ dsts $ \dst -> do
    rshift dst
    reset
    lshift dst

  moveN' (From src) (To dsts)

From и To, которые использованы выше, ничего, по сути, не делают. Это просто слова-обёртки, чтобы не путаться откуда и куда мы всё передаём. Из-за них нужно писать move (From a) (To b), вместо move a b. Первое лично мне понятнее, поэтому я буду придерживаться такого стиля.

Добавим move-ы, которые будут использоваться чаще всего, в отдельные функции, чтобы меньше писать

move :: From Int -> To Int -> CodeGen ()  
move (From src) (To dst) = moveN (From src) (To [dst])

move2 :: From Int -> To Int -> To Int -> CodeGen ()  
move2 (From src) (To dst1) (To dst2) = moveN (From src) (To [dst1, dst2])

Почти везде будет использоваться безопасная (нештрихованная) версия.

Из грязи в князи, от ячеек к регистрам

Как в настоящей машине Тьюринга, заведём пишущую головку, которая будет способна перемещаться по ленте. Почти как та, что есть в bfc из коробки. Но! Эта пишущая головка будет иметь состояние. В ней будет хранится какое-то количество регистров, которые не будут терять своё состояние при перемещении.

Определим буфера, регистры общего назначения и временные регистры.

data Register = BackBuf | GP Int | T Int | FrontBuf deriving (Eq, Show)

gpRegisters :: Int
gpRegisters = 16

tmpRegisters :: Int
tmpRegisters = 16

Вместе с ней определяем функцию relativePos, которая на деле синоним к fromEnum. Код приводить не буду, он громоздкий и скучный, но в двух словах: за ноль берётся регистр GP 0, BackBuf имеет позицию -1, после шестнадцати GP регистров идут 16 T регистров, а после них FrontBuf.
После каждой ассемблерной инструкции мы будем возвращаться в позицию GP 0, чтобы относительные адреса никогда не менялись.

inc и dec для регистров

Первое и самое простое, что можно сделать с регистрами это научиться их увеличивать и уменьшать на единицу. Для этого находим положение регистра, идём туда, увеличиваем ячейку на один и возвращаемся в GP 0.

withShift :: Int -> CodeGen () -> CodeGen ()
withShift shift body = do
  rshift shift
  body
  lshift shift

inc :: Register -> CodeGen ()
inc reg = do
  let pos = relativePos reg
  withShift pos $ tell [Inc]

dec :: Register -> CodeGen ()
dec reg = do
  let pos = relativePos reg
  withShift pos $ tell [Dec]

Аналогично делаем определяем ввод и вывод. Соответствующие функции названы inp и out.

Загрузка константы в регистр

Код почти такой же: смещаемся, обнуляем регистр, увеличиваем до нужного значения, возвращаемся к базовому адресу

set :: Register -> Int -> CodeGen ()
set reg val = do
  let pos = relativePos reg

  withShift pos $ do
    reset
    tell (replicate val Inc)

Заодно определяем красивый синоним

($=) :: Register -> Int -> CodeGen ()
($=) = set

Теперь можно писать GP 0 $= 10

Ассемлерная инструкция mov

mov — это первая высокоуровневая инструкция, в которой придётся использовать временные регистры. По умолчанию всегда будем брать первый не занятый регистр. В нашем случае это T 0
Алгоритм переноса такой: сначала переносим значение из регистра x в y и T 0. Потом из T 0 возвращаем значение назад в x, так как move2 испортил значение в x

mov :: From Register -> To Register -> CodeGen ()
mov (From x) (To y) = do
  let src = relativePos x
      dst = relativePos y
      buf = relativePos (T 0)

  move2 (From src) (To dst) (To buf)
  move (From buf) (To src)

Да, mov с регистром T 0 работать не будет. Такой особый временный регистр, в который даже mov-нуть ничего нельзя.

Сложение и вычитание регистров

Привожу только сложение, так как вычитание аналогично:

add :: Register -> To Register -> CodeGen ()
add x (To y) = do
  let src = relativePos x
      dst = relativePos y
      buf = relativePos $ T 0

  -- Переходим к регистру x, чтобы цикл работал правильно
  withShift src $ do
    loop $ do
      tell [Dec] -- Отнимаем единицу
      withShift (-src) $ do -- Относительно базового адреса делаем:
        withShift dst $ tell [Inc] -- Прибавляем 1 к регистру y
        withShift buf $ tell [Inc] -- Прибавляем 1 к буферу

  move (From buf) (To src) -- Переносим буфер обратно в x

В sub изменено одно единственное слово: Inc заменено на Dec в строчке "Прибавляем 1 к регистру y"

Циклы и ветвления

Цикл while принимает на вход регистр и повторяет действия пока в этом регистре не окажется ноль. Для этого нам необходимо, чтобы когда мы начинаем цикл, мы были в ячейке данного регистра, поэтому смещаемся на pos. Но ассемблерные инструкции (тело цикла) требует, чтобы мы всегда были в ячейке GP 0, поэтому в начале цикла смещаемся назад и только потом вызываем само тело цикла.

while :: Register -> CodeGen () -> CodeGen ()
while reg body = do
  let pos = relativePos reg

  withShift pos $ 
    loop $ withShift (-pos) $ body

Ветвление это, можно сказать, цикл, в который мы заходим не более одного раза. В конце цикла уносим регистр в буфер, цикл завершается, так как в регистре ноль, а значение мы возвращаем назад.

when :: Register -> CodeGen () -> CodeGen ()
when reg body = do
  let pos = relativePos reg
      buf = relativePos (T 0)

  while reg $ do
    body
    move (From pos) (To buf)

  move (From buf) (To pos)

Работа с лентой

Пришло время научить нашу машину работать с памятью. Регистров у нас, конечно, много но одними ими сыт не будешь. Первое что нужно научиться делать — загружать и выгружать значения из регистров, так как на их основе будет работать доступ к произвольной ячейке в памяти

Загрузка и выгрузка значений

Загрузка и разгрузка будут происходить в ячейку сразу после переднего буфера

Нового тут мало, так как это буквально тот же код, что был в mov-ах, с тем исключением, что один "регистр" (ячейка перед пишущей головкой регистром не является) фиксирован

load :: Register -> CodeGen ()
load reg = do
  let dst = relativePos reg
      src = relativePos FrontBuf + 1
      buf = relativePos (T 0)

  move2 (From src) (To dst) (To buf)
  move (From buf) (To src)

store :: Register -> CodeGen ()
store reg = do
  let src = relativePos reg
      dst = relativePos FrontBuf + 1
      buf = relativePos (T 0)

  move2 (From src) (To dst) (To buf)
  move (From buf) (To src)

Мини-босс: Смещение пишущей головки

Сначала переходим к самому правому регистру. Это последний из T-регистров или первый перед FrontBuf. Смещаем регистры на один вправо.

При этом происходит коллизия FrontBuf и ячейки перед машинкой, поэтому перемещаем её в пустое место перед BackBuf

shrCaret :: CodeGen ()
shrCaret = do
  let buf = relativePos FrontBuf
      buf2 = relativePos BackBuf
  rshift buf
  replicateM (gpRegisters + tmpRegisters) $ do
    move (From $ -1) (To 0)
    lshift 1

  rshift 1
  move (From buf) (To $ buf2 - 1)

Смещение влево аналогично, код приводить не буду

Произвольный доступ к памяти

Фух, ну наконец-то, добрались до этой части. Это последняя принципиальная абстракция, скоро перейдём к примерам

derefRead :: From (Ptr Register) -> To Register -> CodeGen ()
derefRead (From (Ptr ptr)) (To reg) = do
  -- Используем T 1, так как T 0 будет испорчен mov инструкцией
  let counter = T 1

  -- Путешествие до участка памяти
  mov (From ptr) (To counter)
  while counter $ do
    shrCaret
    dec counter
  -- Сохраняем на сколько мы ушли, вдруг ptr и reg совпадают
  -- Тогда load потеряет данные
  mov (From ptr) (To counter)

  load reg
  -- Путешествуем назад
  while counter $ do
    shlCaret
    dec counter

derefWrite работает абсолютно аналогично.
Тут, как и с move я ввёл обёртку Ptr, чтобы внести ясность

Примеры

Числа фибоначчи

Посчитаем пятое число фибоначчи

program :: CodeGen ()
program = do
  -- Чтобы BackBuf не выползал за начало ленты (его позиция -- -1)
  -- Смещаемся на 1 вправо
  initCaret

  -- Определяем говорящие синонимы для регистров
  let counter = GP 0
      prev    = GP 1
      next    = GP 2
      tmp     = T 1

  counter $= 5 -- Делаем цикл пять раз
  prev $= 0
  next $= 1

  -- Классический алгоритм для подсчёта чисел Фибоначчи
  while counter $ do
    dec counter

    mov (From next) (To tmp)
    add prev (To next)
    mov (From tmp) (To prev)

  -- Чтобы вывести символ, нужно чтобы он был в каком-то регистре
  -- Выводить будем в одинарной системе счисления, потому что так проще
  let char = tmp
  char $= fromEnum '1'

  while prev $ do
    dec prev
    out char

  -- Перенос строки для красоты
  char $= fromEnum '\n'
  out char

>[-]+>[-]+++++<>[<>>>>>>[-]<<<<<<>>>>>>>>[-]<<<<<<<<[->>>>>>+<<<<<<>>>>>>>>+<<<<<<<<][-]>>>>>>>>[-<<<<<<<<+>>>>>>>>]<<<<<<<<>>>>>>>[-]<<<<<<<>>>>>>[<<<<<<>>>>>>-<<<<<<>>>>>>>>[-]<<<<<<<<<[-]>>[-<>>>>>>>>+<<<<<<<<<+>>]<>[-]>>>>>>>[-<<<<<<<+>>>>>>>]<<<<<<<<<[->>>>>>>>+<<<<<<<<]>>>>>>>]<<<<<<[-]>>>>>>>>[-]<<<<<<<<>>>>>>>[-<<<<<<<+>>>>>>>>+<<<<<<<<>>>>>>>]<<<<<<<>>>>>>>[-]>[-<+>]<<<<<<<<>-<>]<>>>>>[-]<<<<<[>>[-]<<>>>>>>>>[-]<<<<<<<<[->>+<<>>>>>>>>+<<<<<<<<][-]>>>>>>>>[-<<<<<<<<+>>>>>>>>]<<<<<<<<>[-]+<[->>>>>>>>[-]<<<<<<<[->>>>>>>+<<<<<<<]<>+<>>>>>>>>[<<<<<<<<>[-]<>>>>>>>>[-]]<<<<<<<<]>[<>>>>>>>[-]++++++++++++++++++++++++++++++++++++++++++++++++<<<<<<<>>>>>>>>[-]<<<<<<<[->>>>>>>+<<<<<<<]<>]<>[-]>>>>>>>[-<<<<<<<+>>>>>>>]<<<<<<<<>>>>>>>>[-]<<<<<<<[->>>>>>>+<<<<<<<]<>+<>>>>>>>>[<<<<<<<<>[-]<>>>>>>>>[-]]<<<<<<<<>[<>>>>>>>[-]+++++++++++++++++++++++++++++++++++++++++++++++++<<<<<<<>>-<<>>>>>>>>[-]<<<<<<<[->>>>>>>+<<<<<<<]<>]<>[-]>>>>>>>[-<<<<<<<+>>>>>>>]<<<<<<<<>>>>>>>>[-]<<<<<<<<>>>>>>>>>[-]<<<<<<<<<>>>>>>>[-<<<<<<<>>>>>>>>+<<<<<<<<>>>>>>>>>+<<<<<<<<<>>>>>>>]<<<<<<<>>>>>>>[-]>[-<+>]<<<<<<<<>>>>>>>>[-]<[->+<]<<<<<<<>>>>>>>[-]<[->+<]<<<<<<>>>>>>[-]<[->+<]<<<<<>>>>>[-]<[->+<]<<<<>>>>[-]<[->+<]<<<>>>[-]<[->+<]<<>>[-]<[->+<]<>[-]<[->+<]<[-]>>>>>>>>>>[-<<<<<<<<<<+>>>>>>>>>>]<<<<<<<<<>>>>>>+<<<<<>>[<<>>-<<>>-<<+>>]<<]>>>>>[<<<<<>>>>>-<<<<<<[-]>[-<+>][-]>[-<+>]<>[-]>[-<+>]<<>>[-]>[-<+>]<<<>>>[-]>[-<+>]<<<<>>>>[-]>[-<+>]<<<<<>>>>>[-]>[-<+>]<<<<<<>>>>>>[-]>[-<+>]<<<<<<<>>>>>>>>[-]<<<<<<<<<<[->>>>>>>>>>+<<<<<<<<<<]>><>>>>>>>>[-]<<<<<<<<[-]>>>>>>>>>[-<<<<<<<<<>>>>>>>>+<<<<<<<<+>>>>>>>>>]<<<<<<<<<>>>>>>>>>[-]<[->+<]<<<<<<<<.>>>>>]<<<<<

Ваш хаскель только для факториалов и годится

Чистая правда. Напишем свой факториал

mul :: Register -> To Register -> CodeGen ()
mul x (To y) = do
  -- Т 0 уже занят mov и add 
  let acc = T 1
      counter = T 2

  acc $= 0
  mov (From y) (To counter)

  -- Умножение это сложение, просто много раз
  -- y раз к acc прибавляем x 
  while counter $ do
    add x (To acc)
    dec counter

  -- Сохраняем результат
  mov (From acc) (To y)

program :: CodeGen ()
program = do
  let n   = GP 0
      acc = GP 1

  n $= 5
  acc $= 1

  while n $ do
    mul n (To acc)
    dec n

  let char = T 1
  char $= fromEnum '1'

  while acc $ do
    dec acc
    out char

  char $= fromEnum '\n'
  out char

[-]+++++>[-]+<[>>>>>>>>>>>>>>>>>[-]<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>[-]<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>[-]<<<<<<<<<<<<<<<<>[-<>>>>>>>>>>>>>>>>>>+<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>+<<<<<<<<<<<<<<<<>]<>[-]<>>>>>>>>>>>>>>>>[-<<<<<<<<<<<<<<<<>+<>>>>>>>>>>>>>>>>]<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>[<<<<<<<<<<<<<<<<<<[->>>>>>>>>>>>>>>>>+<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>+<<<<<<<<<<<<<<<<][-]>>>>>>>>>>>>>>>>[-<<<<<<<<<<<<<<<<+>>>>>>>>>>>>>>>>]<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>-<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>]<<<<<<<<<<<<<<<<<<>[-]<>>>>>>>>>>>>>>>>[-]<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>[-<<<<<<<<<<<<<<<<<>+<>>>>>>>>>>>>>>>>+<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>]<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>[-]<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>[-<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>+<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>]<<<<<<<<<<<<<<<<-]>>>>>>>>>>>>>>>>>[-]+++++++++++++++++++++++++++++++++++++++++++++++++<<<<<<<<<<<<<<<<<>[<>-<>>>>>>>>>>>>>>>>>.<<<<<<<<<<<<<<<<<>]<>>>>>>>>>>>>>>>>>[-]++++++++++<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>.<<<<<<<<<<<<<<<<<

А в двоичной можно вывести?

Да легко!

-- Булево НЕ
inv :: Register -> CodeGen ()
inv reg = do
  let tmp = T 1

  mov (From reg) (To tmp)
  reg $= 1
  when tmp $ do
    reg $= 0

-- Работа с лентой как со стеком
push reg = do
  store reg
  shrCaret

pop reg = do
  shlCaret
  load reg

program :: CodeGen ()
program = do
  initCaret 
  let number = GP 0
      digits = GP 1
      char = T 2

  number $= 64 
  digits $= 0 -- Сохраняем количество цифр, чтобы не провалить стек

  while number $ do
    let tmp    = T 3
        isEven = T 4

    -- Находим чётность числа
    isEven $= 1

    mov (From number) (To tmp)    
    while tmp $ do
      inv isEven
      dec tmp

    -- Если делится на два 
    when isEven $ do
      char $= fromEnum '0'

    -- Если не делится на два
    inv isEven
    when isEven $ do
      char $= fromEnum '1'
      -- Делаем так, чтобы делилось
      dec number

    -- Записываем цифру в стек
    push char
    inc digits

    -- Делим число на два
    mov (From number) (To tmp)
    number $= 0
    while tmp $ do
      tmp -= 2
      number += 1

  -- Выводим по одной цифре
  while digits $ do
    pop char
    out char
    dec digits
  -- Ну и перенос строки
  char $= fromEnum '\n'
  out char

>[-]++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++>[-]<[>>>>>>>>>>>>>>>>>>>>[-]+<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>[-]<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>[-]<<<<<<<<<<<<<<<<[->>>>>>>>>>>>>>>>>>>+<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>+<<<<<<<<<<<<<<<<][-]>>>>>>>>>>>>>>>>[-<<<<<<<<<<<<<<<<+>>>>>>>>>>>>>>>>]<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>[<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>[-]<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>[-]<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>[-<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>+<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>+<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>]<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>[-]<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>[-<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>+<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>]<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>[-]+<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>[<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>[-]<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>[-]<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>[-<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>+<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>]<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>]<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>[-]<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>[-<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>+<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>]<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>-<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>]<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>[<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>[-]++++++++++++++++++++++++++++++++++++++++++++++++<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>[-]<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>[-<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>+<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>]<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>]<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>[-]<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>[-<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>+<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>]<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>[-]<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>[-]<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>[-<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>+<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>+<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>]<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>[-]<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>[-<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>+<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>]<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>[-]+<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>[<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>[-]<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>[-]<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>[-<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>+<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>]<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>]<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>[-]<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>[-<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>+<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>]<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>[<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>[-]+++++++++++++++++++++++++++++++++++++++++++++++++<<<<<<<<<<<<<<<<<<->>>>>>>>>>>>>>>>[-]<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>[-<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>+<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>]<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>]<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>[-]<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>[-<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>+<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>]<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>[-]<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>[-]<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>[-<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>+<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>+<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>]<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>[-]<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>[-<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>+<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>]<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>[-]<[->+<]><[-]<[->+<]><[-]<[->+<]><[-]<[->+<]><[-]<[->+<]><[-]<[->+<]><[-]<[->+<]><[-]<[->+<]><[-]<[->+<]><[-]<[->+<]><[-]<[->+<]><[-]<[->+<]><[-]<[->+<]><[-]<[->+<]><[-]<[->+<]><[-]<[->+<]><[-]<[->+<]><[-]<[->+<]><[-]<[->+<]><[-]<[->+<]><[-]<[->+<]><[-]<[->+<]><[-]<[->+<]><[-]<[->+<]><[-]<[->+<]><[-]<[->+<]><[-]<[->+<]><[-]<[->+<]><[-]<[->+<]><[-]<[->+<]><[-]<[->+<]><[-]<[->+<]><><<[-]>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>[-<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<+>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>]<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>+<>>>>>>>>>>>>>>>>>>>[-]<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>[-]<<<<<<<<<<<<<<<<[->>>>>>>>>>>>>>>>>>>+<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>+<<<<<<<<<<<<<<<<][-]>>>>>>>>>>>>>>>>[-<<<<<<<<<<<<<<<<+>>>>>>>>>>>>>>>>]<<<<<<<<<<<<<<<<[-]>>>>>>>>>>>>>>>>>>>[<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>--<<<<<<<<<<<<<<<<<<<+>>>>>>>>>>>>>>>>>>>]<<<<<<<<<<<<<<<<<<<]>[<<[-]>[-<+>]<>[-]>[-<+>]<>[-]>[-<+>]<>[-]>[-<+>]<>[-]>[-<+>]<>[-]>[-<+>]<>[-]>[-<+>]<>[-]>[-<+>]<>[-]>[-<+>]<>[-]>[-<+>]<>[-]>[-<+>]<>[-]>[-<+>]<>[-]>[-<+>]<>[-]>[-<+>]<>[-]>[-<+>]<>[-]>[-<+>]<>[-]>[-<+>]<>[-]>[-<+>]<>[-]>[-<+>]<>[-]>[-<+>]<>[-]>[-<+>]<>[-]>[-<+>]<>[-]>[-<+>]<>[-]>[-<+>]<>[-]>[-<+>]<>[-]>[-<+>]<>[-]>[-<+>]<>[-]>[-<+>]<>[-]>[-<+>]<>[-]>[-<+>]<>[-]>[-<+>]<>[-]>[-<+>]<><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>[-]<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<[->>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>+<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<]>>>>>>>>>>>>>>>>>>>[-]<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>[-]<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>[-<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>+<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>+<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>]<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>[-]<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>[-<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>+<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>]<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>.<<<<<<<<<<<<<<<<<<>-<>]<>>>>>>>>>>>>>>>>>>[-]++++++++++<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>.<<<<<<<<<<<<<<<<<<

UPD: Градиентная картинка

К bfc достаточно легко прикрутить вывод в файлик. Netpbm очень простой файловый формат. Попробуем сгенерировать что-то:

-- вывод текста
bprint :: String -> CodeGen ()
bprint str = do
  let tmp = T 0
  forM_ str $ \char -> do
    tmp $= fromEnum char
    out tmp

program :: CodeGen ()
program = do
  initCaret
  -- Заголовок файла
  bprint "P6\n"
  -- Размер картинки 255x255
  bprint "255 255\n"
  -- Максимальное значение цвета
  bprint "255\n"

  c $= 127
  a $= 255
  -- Двойной цикл по картинке
  while a $ do
    b $= 255
    while b $ do
      out a -- Red
      out b -- Green
      out c -- Blue
      dec b
    dec a

Вывод у програмки бинарный, поэтому показывать его не буду

>>>>>>>>>>>>>>>>>[-]++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.--------------------------.--------------------------------------------.----------[-]++++++++++++++++++++++++++++++++++++++++++++++++++.+++..---------------------.++++++++++++++++++.+++..-------------------------------------------.----------[-]++++++++++++++++++++++++++++++++++++++++++++++++++.+++..-------------------------------------------.----------<<<<<<<<<<<<<<[-]+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++<<[-]+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++[>[-]+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++[<.>.>.<-]<-]

Footer

Ну вот, статья подошла к концу. Время заветной картинки