Pure BF/Implementation

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)