Pure BF/Implementation

← Back to Pure BF

This is an implementation of Pure BF in Haskell. (This wiki article is a valid Haskell code. If you download the raw article code, and give the file a ".lhs" extension then you can load it in a Haskell compiler/interpreter.)

> module PureBF where {
> import Control.Applicative;
> import Control.Comonad;
> import Control.Monad;
> import Data.Monoid;
> import Data.Word;

Utility Function

> bool :: x -> x -> Bool -> x;
> bool x _ False = x;
> bool _ x True = x;

> transEnum :: (Enum x, Enum y) => x -> y;
> transEnum = toEnum . fromEnum;

Value Wrapping

This implements wrapping of values.

> succ8 :: Word8 -> Word8;
> succ8 255 = 0;
> succ8 x = succ x;

> pred8 :: Word8 -> Word8;
> pred8 0 = 255;
> pred8 x = pred x;

Program Types

This is the same type as described in the Pure BF article.

> type Program = (Tape, World) -> (Tape, World);

But now, Tape and World still have to be defined. The tape is infinite. The world simply consists of an input stream and an output stream (not properly interactive).

> type Tape = Sum Integer -> Word8;
> type World = ([Word8], [Word8]);

The tape is a function from the position number to the value. The position number is Sum 0 for the head position, negative for to the left, and positive for to the right. So it is shifted left/right by composing the input.

The reason for Sum Integer is to make a monoid, so that it can be used as a comonad (see below).

Operations

Increment:

> increment :: Program;
> increment (t, w) = (t >>= flip (bool id succ8 . (== Sum 0)), w);

Decrement:

> decrement :: Program;
> decrement (t, w) = (t >>= flip (bool id pred8 . (== Sum 0)), w);

Next cell:

> next :: Program;
> next (t, w) = (t =>> ($ Sum 1), w);

Previous cell:

> prev :: Program;
> prev (t, w) = (t =>> ($ Sum (-1)), w);

Input (using convention where EOF sets cell to 0):

> input :: Program;
> input (t, (ih : it, o)) = (\x -> bool ih (t x) (x == Sum 0), (it, o));
> input (t, ([], o)) = (\x -> bool 0 (t x) (x == Sum 0), ([], o));

Output:

> output :: Program;
> output (t, (i, o)) = (t, (i, o ++ [extract t]));

Loop:

> loop :: Program -> Program;
> loop f (t, w) = bool (loop f . f) id (extract t == 0) (t, w);

Compiler

> compile :: String -> Program;
> compile [] = id;
> compile ('+' : x) = compile x . increment;
> compile ('-' : x) = compile x . decrement;
> compile ('<' : x) = compile x . prev;
> compile ('>' : x) = compile x . next;
> compile (',' : x) = compile x . input;
> compile ('.' : x) = compile x . output;
> compile ('[' : x) = case (parseLoop 1 ([], x)) of {
>   (inner, outer) -> compile outer . loop (compile inner);
> };
> compile (']' : x) = error "End loop with no begin loop";
> compile (_ : x) = compile x;

Now we have to parse the matching pair of brackets to make loops.

> parseLoop :: Int -> (String, String) -> (String, String);
> parseLoop 0 x = x;
> parseLoop n (x, '[' : t) = parseLoop (succ n) (x ++ "[", t);
> parseLoop n (x, ']' : t) = parseLoop (pred n) (x ++ (guard (n /= 1) >> "]"), t);
> parseLoop n (x, h : t) = parseLoop n (x ++ [h], t);
> parseLoop n (x, []) = error "Unterminated loop block";

Interpreter

This program uses Lazy I/O to attempt to make a brainfuck program working.

> interpret :: Program -> IO ();
> interpret p = interact $ \i -> transEnum <$> snd (snd (p (const 0, (transEnum <$> i, []))));

Download

• PureBF.lhs (You have to give this file a .lhs extension to load it into Haskell)