Brainf*** Interpreter

Mars sample program (Download)

#!/usr/bin/env mars

# Brainf*** Interpreter
# This is intended as a demonstration of the Mars programming language,
# particularly its turing completeness, its simple IO, and array manipulation.
#
# Note that at present, Mars does not allow files to be opened (only input is
# through stdin). This is similar to Brainf*** itself. In order to write
# Brainf*** in itself, authors commonly separate the code and data with a "!",
# as shown here:
# http://www.hevanet.com/cristofd/08.html
# We take this same approach.
#
# This implementation is loosely based on the C++ algorithm at the above
# address. It has undefined behaviour in the following circumstances:
# - Non-matching brackets.
# - Using negative elements of the array, or elements beyond 30,000.
# It stores 0 on EOF, and has wrapping 256-valued cells.

import prelude

def array_size :: Num = 30000

# get_till_bang()
# Reads from stdin, storing the characters in an array.
# Stops reading once it sees a '!' character, or EOF. Consumes the '!'.
# Returns the array.
def get_till_bang() :: io Array(Num):
    var s :: Array(Num)
    var c :: Num
    s = array(0, 0)     # Empty array
    c = get_char()
    while and(c != eof, c != '!'):      # while c != -1 and c != '!'
        s = array_add(s, c)
        c = get_char()
    return s

# init_array()
# Creates a new array of size array_size, and initialises all elements to 0.
def init_array :: Array(Num) = array(array_size, 0)

# main program
def main() :: io Num:
    var ip :: Num       # Instruction pointer
    var dp :: Num       # Data pointer
    var program :: Array(Num)
    var array :: Array(Num)

    # Read the file up until the '!'
    program = get_till_bang()
    array = init_array

    # Execute the program
    return main_loop(program, array)

# main_loop(program, array)
# Executes the program.
# Side-effects: stdin, stdout.
def main_loop(program :: Array(Num), array :: Array(Num)) :: io Num:
    var c :: Num    # Temporary character
    var ip :: Num   # Instruction pointer
    var dp :: Num   # Data pointer

    ip = 0
    dp = 0

    while ip < array_length(program):
        switch array_ref(program, ip):
            case '>':
                dp = dp + 1
            case '<':
                dp = dp - 1
            case '+':
                # array[dp]++
                array = array_replace(array, dp, array_ref(array, dp) + 1)
            case '-':
                # array[dp]--
                array = array_replace(array, dp, array_ref(array, dp) - 1)
            case '.':
                put_char(array_ref(array, dp))
            case ',':
                c = get_char()
                if c == eof:
                    array = array_replace(array, dp, 0)
                else:
                    array = array_replace(array, dp, c)
            case '[':
                # Skip to ']' if false
                if array_ref(array, dp) == 0:
                    ip = seek_close_bracket(program, ip, 1)
            case ']':
                # Skip to '[' if true
                if array_ref(array, dp) != 0:
                    ip = seek_open_bracket(program, ip, 1)
            case _:
                pass

        ip = ip + 1

    return 0

# Moves the program counter forwards, looking for a ']' to match '['.
# Returns the updated program counter.
# No side-effects.
def seek_close_bracket(program :: Array(Num), ip :: Num, nest :: Num) :: Num:
    while nest > 0:
        ip = ip + 1
        switch array_ref(program, ip):
            case '[':
                nest = nest + 1
            case ']':
                nest = nest - 1
            case _:
                pass
    return ip

# Moves the program counter backwards, looking for a '[' to match ']'.
# Returns the updated program counter.
# No side-effects.
def seek_open_bracket(program :: Array(Num), ip :: Num, nest :: Num) :: Num:
    while nest > 0:
        ip = ip - 1
        switch array_ref(program, ip):
            case '[':
                nest = nest - 1
            case ']':
                nest = nest + 1
            case _:
                pass
    return ip