hbf-0.1.0.0: An optimizing Brainfuck compiler and evaluator

Copyright(c) Sebastian Galkin 2018
LicenseGPL-3
Safe HaskellNone
LanguageHaskell2010

HBF.Types

Contents

Description

All the basic types for the Brainfuck compiler and VM are defined in this module. This includes the different instructions (Ops), the Program and the MachineIO.

Synopsis

Virtual Machine Instructions

data Op Source #

Operations or instructions in the Brainfuck virtual machine.

Some of these operations are "native" to Brainfuck and others are the result of optimization during compilation. The compiler generates these types of instructions and the virtual machine can execute them.

In all these instructions the MemOffset represents a shift relative to the current position of the pointer. The operation will refer and apply its action to this shifted position.

Constructors

Inc !Int !MemOffset

Increment by the amount specified by the Int

Move !MemOffset

Move the current pointer by the specified amount

In !Int !MemOffset

Repeatedly read a byte into the machine and write the last one read to the shifted position. n is usually 1 in real programs, but not always. Where the byte is read from will depend on the MachineIO impleentation.

Out !Int !MemOffset

Repeatedly write the byte in the shifted position. Where the byte is written will depend on the MachineIO impleentation.

Loop ![Op]

Native Brainfuck looping instruction.

Clear !MemOffset

Optimized instruction. Set the shifted position to zero. In Brainfuck this is usually written as [-]

Mul !MulFactor !MemOffset !MemOffset

Optimized instruction. Multiply by the factor the byte in the first MemOffset, writting to the second one. Second MemOffset is relative to the first one. In brainfuck this is usually written as [->+<] and similar expressions.

Scan !Direction !MemOffset

Find the nearest zero in the given direction, starting at the offset position. See Direction.

Instances

Eq Op Source # 

Methods

(==) :: Op -> Op -> Bool #

(/=) :: Op -> Op -> Bool #

Show Op Source # 

Methods

showsPrec :: Int -> Op -> ShowS #

show :: Op -> String #

showList :: [Op] -> ShowS #

Generic Op Source # 

Associated Types

type Rep Op :: * -> * #

Methods

from :: Op -> Rep Op x #

to :: Rep Op x -> Op #

Binary Op Source # 

Methods

put :: Op -> Put #

get :: Get Op #

putList :: [Op] -> Put #

NFData Op Source # 

Methods

rnf :: Op -> () #

type Rep Op Source # 
type Rep Op = D1 * (MetaData "Op" "HBF.Types" "hbf-0.1.0.0-Hy2GPGZPYftJgyxAT1vxqV" False) ((:+:) * ((:+:) * ((:+:) * (C1 * (MetaCons "Inc" PrefixI False) ((:*:) * (S1 * (MetaSel (Nothing Symbol) SourceUnpack SourceStrict DecidedStrict) (Rec0 * Int)) (S1 * (MetaSel (Nothing Symbol) SourceUnpack SourceStrict DecidedStrict) (Rec0 * MemOffset)))) (C1 * (MetaCons "Move" PrefixI False) (S1 * (MetaSel (Nothing Symbol) SourceUnpack SourceStrict DecidedStrict) (Rec0 * MemOffset)))) ((:+:) * (C1 * (MetaCons "In" PrefixI False) ((:*:) * (S1 * (MetaSel (Nothing Symbol) SourceUnpack SourceStrict DecidedStrict) (Rec0 * Int)) (S1 * (MetaSel (Nothing Symbol) SourceUnpack SourceStrict DecidedStrict) (Rec0 * MemOffset)))) (C1 * (MetaCons "Out" PrefixI False) ((:*:) * (S1 * (MetaSel (Nothing Symbol) SourceUnpack SourceStrict DecidedStrict) (Rec0 * Int)) (S1 * (MetaSel (Nothing Symbol) SourceUnpack SourceStrict DecidedStrict) (Rec0 * MemOffset)))))) ((:+:) * ((:+:) * (C1 * (MetaCons "Loop" PrefixI False) (S1 * (MetaSel (Nothing Symbol) NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 * [Op]))) (C1 * (MetaCons "Clear" PrefixI False) (S1 * (MetaSel (Nothing Symbol) SourceUnpack SourceStrict DecidedStrict) (Rec0 * MemOffset)))) ((:+:) * (C1 * (MetaCons "Mul" PrefixI False) ((:*:) * (S1 * (MetaSel (Nothing Symbol) SourceUnpack SourceStrict DecidedStrict) (Rec0 * MulFactor)) ((:*:) * (S1 * (MetaSel (Nothing Symbol) SourceUnpack SourceStrict DecidedStrict) (Rec0 * MemOffset)) (S1 * (MetaSel (Nothing Symbol) SourceUnpack SourceStrict DecidedStrict) (Rec0 * MemOffset))))) (C1 * (MetaCons "Scan" PrefixI False) ((:*:) * (S1 * (MetaSel (Nothing Symbol) NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 * Direction)) (S1 * (MetaSel (Nothing Symbol) SourceUnpack SourceStrict DecidedStrict) (Rec0 * MemOffset)))))))

newtype MemOffset Source #

An offset into the Brainfuck VM memory. Positive numbers are in the direction of higher memory.

Constructors

MemOffset Int 

newtype MulFactor Source #

A factor to multiply by in the Mul instruction.

Constructors

MulFactor Int 

data Direction Source #

A direction to Scan for a memory position. Up is in the direction of higher memory.

Constructors

Up

Scan in the direction of higher memory.

Down

Scan in the direction of lower memory.

Instances

Eq Direction Source # 
Show Direction Source # 
Generic Direction Source # 

Associated Types

type Rep Direction :: * -> * #

Binary Direction Source # 
NFData Direction Source # 

Methods

rnf :: Direction -> () #

type Rep Direction Source # 
type Rep Direction = D1 * (MetaData "Direction" "HBF.Types" "hbf-0.1.0.0-Hy2GPGZPYftJgyxAT1vxqV" False) ((:+:) * (C1 * (MetaCons "Up" PrefixI False) (U1 *)) (C1 * (MetaCons "Down" PrefixI False) (U1 *)))

Programs

data Optimized Source #

Marker type to distinguish optimized and Unoptimized Programs.

data Unoptimized Source #

Marker type to distinguish Optimized and unoptimized Programs.

newtype Program opt Source #

A list of Ops. opt will be one of Optimized or Unoptimized to distinguish both types of programs at the type level.

Constructors

Program 

Fields

Instances

Eq (Program opt) Source # 

Methods

(==) :: Program opt -> Program opt -> Bool #

(/=) :: Program opt -> Program opt -> Bool #

Show (Program opt) Source # 

Methods

showsPrec :: Int -> Program opt -> ShowS #

show :: Program opt -> String #

showList :: [Program opt] -> ShowS #

Generic (Program opt) Source # 

Associated Types

type Rep (Program opt) :: * -> * #

Methods

from :: Program opt -> Rep (Program opt) x #

to :: Rep (Program opt) x -> Program opt #

Semigroup (Program o) Source #

Apply <> to the underlying List of instructions.

Methods

(<>) :: Program o -> Program o -> Program o #

sconcat :: NonEmpty (Program o) -> Program o #

stimes :: Integral b => b -> Program o -> Program o #

Monoid (Program o) Source #

The Monoid of the underlying List of instructions.

Methods

mempty :: Program o #

mappend :: Program o -> Program o -> Program o #

mconcat :: [Program o] -> Program o #

Binary (Program opt) Source # 

Methods

put :: Program opt -> Put #

get :: Get (Program opt) #

putList :: [Program opt] -> Put #

NFData (Program opt) Source # 

Methods

rnf :: Program opt -> () #

type Rep (Program opt) Source # 
type Rep (Program opt) = D1 * (MetaData "Program" "HBF.Types" "hbf-0.1.0.0-Hy2GPGZPYftJgyxAT1vxqV" True) (C1 * (MetaCons "Program" PrefixI True) (S1 * (MetaSel (Just Symbol "instructions") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * [Op])))

flattened :: Program o -> [Op] Source #

Return the full list of instructions in a program, by unrolling Loop instructions into the list.

>>> flattened $ Program [Inc 1 0, Loop [Move 1, Scan Up 0]]
[Inc 1 0,Move 1,Scan Up 0]

Runtime State

data Machine v Source #

The state of a Brainfuck virtual machine.

Constructors

Machine 

Fields

  • memory :: v

    The full memory of the machine. This will be a Vector or a List.

  • pointer :: MemOffset

    The current execution pointer, information is written and read at this position.

Instances

Eq v => Eq (Machine v) Source # 

Methods

(==) :: Machine v -> Machine v -> Bool #

(/=) :: Machine v -> Machine v -> Bool #

Show v => Show (Machine v) Source # 

Methods

showsPrec :: Int -> Machine v -> ShowS #

show :: Machine v -> String #

showList :: [Machine v] -> ShowS #

VM Input/Output

class MachineIO m where Source #

Provide input and output to a Brainfuck virtual machine.

This class allows to run the VM in different monads, like IO or StateT.

Minimal complete definition

putByte, getByte

Methods

putByte Source #

Arguments

:: Int8 
-> m ()

Write the byte to the output of the VM.

getByte Source #

Arguments

:: m (Maybe Int8)

Read a byte from the input of the VM. If EOF has been reached, return Nothing

Instances

MachineIO IO Source #

IO takes its input and output from stdin/stdout

Methods

putByte :: Int8 -> IO () Source #

getByte :: IO (Maybe Int8) Source #

Monad m => MachineIO (StateT MockIO m) Source #

StateT takes its input and output from the lists inside the MockIO.

Test Helpers

data MockIO Source #

A data structure for mocking input and output to the VM. This can be used to run the VM in a StateT monad for testing purposes.

Constructors

MockIO 

Fields

  • machineIn :: [Int8]

    Every time the machine executes an In instruction, input will be taken from this list.

  • machineOut :: [Int8]

    Every time the machine executes an Out instruction, output will be put into this list, in LIFO order.

Instances

Eq MockIO Source # 

Methods

(==) :: MockIO -> MockIO -> Bool #

(/=) :: MockIO -> MockIO -> Bool #

Show MockIO Source # 
Generic MockIO Source # 

Associated Types

type Rep MockIO :: * -> * #

Methods

from :: MockIO -> Rep MockIO x #

to :: Rep MockIO x -> MockIO #

NFData MockIO Source # 

Methods

rnf :: MockIO -> () #

Monad m => MachineIO (StateT MockIO m) Source #

StateT takes its input and output from the lists inside the MockIO.

type Rep MockIO Source # 
type Rep MockIO = D1 * (MetaData "MockIO" "HBF.Types" "hbf-0.1.0.0-Hy2GPGZPYftJgyxAT1vxqV" False) (C1 * (MetaCons "MockIO" PrefixI True) ((:*:) * (S1 * (MetaSel (Just Symbol "machineIn") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * [Int8])) (S1 * (MetaSel (Just Symbol "machineOut") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * [Int8]))))

mkMockIO :: [Int8] -> MockIO Source #

Create a MockIO that will have the given input available.

mkMockIOS :: String -> MockIO Source #

Create a MockIO that will have the given input available. ASCII encoding.

mockOutput :: MockIO -> [Int8] Source #

Get the output after a VM has ran using this MockIO.

mockOutputS :: MockIO -> String Source #

Get the output after a VM has ran using this MockIO. ASCII encoding.

Helper Functions

(<&>) :: Functor f => f a -> (a -> b) -> f b Source #

<$> with arguments reversed.

eitherToMaybe :: Either a b -> Maybe b Source #

Helper function to convert a Right into a Just and a Left into a Nothing.