brainfuck_interpreter.fs

module Brainfuck =
    type State = { currentIndex : int
                   data : Map<int, byte> }
    type Op = IncPointer | DecPointer | Inc | Dec | Print | Read | While of Op list

    module private Eval =
        type IO = { read : unit -> byte
                    print : byte -> unit }
        with static member def = { read = fun () -> System.Console.Read() |> byte
                                   print = fun i -> char i |> printf "%O" }

        let eval io =
            let rec eval' state ops =
                let currentVal = match state.data.TryFind state.currentIndex with
                                 | Some x -> x
                                 | None -> 0uy
                match ops with
                | IncPointer -> { state with currentIndex = state.currentIndex + 1 }
                | DecPointer -> { state with currentIndex = state.currentIndex - 1 }
                | Inc -> { state with data = state.data.Add (state.currentIndex, currentVal + 1uy) }
                | Dec -> { state with data = state.data.Add (state.currentIndex, currentVal - 1uy) }
                | Print ->
                    currentVal |> io.print
                    state
                | Read ->
                    let v = io.read()
                    { state with data = state.data.Add (state.currentIndex, v) }
                | While ops as x ->
                    if currentVal = 0uy then state
                    else
                        let state = ops |> List.fold eval' state
                        eval' state x   
            List.fold eval' { currentIndex = 0; data = Map.empty }
        
    module private Parser =
        let allowedSymbols = set ['>'; '<'; '+'; '-'; '.'; ','; '['; ']']

        let (|IsStmt|_|) str = 
            let (|IsChar|_|) = function [] -> None | ch::_ -> Some ch
            
            match str with
            | IsChar '>' -> Some IncPointer
            | IsChar '<' -> Some DecPointer
            | IsChar '+' -> Some Inc
            | IsChar '-' -> Some Dec
            | IsChar '.' -> Some Print
            | IsChar ',' -> Some Read
            | _ -> None
            |> Option.map(fun x->x, List.tail str)

        let rec (|Stmts|) (str:char list)  =
            let rec getStmts curr = function
            | (IsParsable (op, remaining)) -> getStmts (op :: curr) remaining
            | remaining -> curr, remaining
            getStmts [] str 
        
        and (|IsWhileLoop|_|) = function
        | '[' :: Stmts (stms, ']' :: xs)  ->
            Some (stms |> List.rev |> While, xs)
        | _ -> None

        and (|IsParsable|_|) = function
        | IsWhileLoop (op, xs)
        | IsStmt (op, xs) -> (op, xs) |> Some
        | _ -> None

        let rec parse' = function
        | [] -> []
        | IsParsable (op, xs) -> op :: parse' xs
        | x -> failwithf "failed parsing %A" x

        let parse s = s |> Seq.filter allowedSymbols.Contains |> List.ofSeq |> parse'

    let eval =  Parser.parse >> Eval.eval Eval.IO.def

    
let helloWorld = """[ This program prints "Hello World!" and a newline to the screen, its
  length is 106 active command characters. [It is not the shortest.]

  This loop is a "comment loop", a simple way of adding a comment
  to a BF program such that you don't have to worry about any command
  characters. Any ".", ",", "+", "-", "<" and ">" characters are simply
  ignored, the "[" and "]" characters just have to be balanced. This
  loop and the commands it contains are ignored because the current cell
  defaults to a value of 0; the 0 value causes this loop to be skipped.
]
++++++++               Set Cell #0 to 8
[
    >++++               Add 4 to Cell #1; this will always set Cell #1 to 4
    [                   as the cell will be cleared by the loop
        >++             Add 2 to Cell #2
        >+++            Add 3 to Cell #3
        >+++            Add 3 to Cell #4
        >+              Add 1 to Cell #5
        <<<<-           Decrement the loop counter in Cell #1
    ]                   Loop till Cell #1 is zero; number of iterations is 4
    >+                  Add 1 to Cell #2
    >+                  Add 1 to Cell #3
    >-                  Subtract 1 from Cell #4
    >>+                 Add 1 to Cell #6
    [<]                 Move back to the first zero cell you find; this will
                        be Cell #1 which was cleared by the previous loop
    <-                  Decrement the loop Counter in Cell #0
]                       Loop till Cell #0 is zero; number of iterations is 8

The result of this is:
Cell No :   0   1   2   3   4   5   6
Contents:   0   0  72 104  88  32   8
Pointer :   ^

>>.                     Cell #2 has value 72 which is 'H'
>---.                   Subtract 3 from Cell #3 to get 101 which is 'e'
+++++++..+++.           Likewise for 'llo' from Cell #3
>>.                     Cell #5 is 32 for the space
<-.                     Subtract 1 from Cell #4 for 87 to give a 'W'
<.                      Cell #3 was set to 'o' from the end of 'Hello'
+++.------.--------.    Cell #3 for 'rl' and 'd'
>>+.                    Add 1 to Cell #5 gives us an exclamation point
>++.                    And finally a newline from Cell #6"""
    

helloWorld |> Brainfuck.eval |> ignore

"-[--->+<]>-.[---->+++++<]>-.+.++++++++++.+[---->+<]>+++.-[--->++<]>-.++++++++++.+[---->+<]>+++.[-->+++++++<]>.++.-------------.[--->+<]>---..+++++.-[---->+<]>++.+[->+++<]>.++++++++++++..---.[-->+<]>--------."
|> Brainfuck.eval