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)
Category:Implementations