8 people like it.

BrainFuck

A Small BrainFuck Interpretor (~50 lines). Probably not very efficient only started learning F# a few days ago.

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
24: 
25: 
26: 
27: 
28: 
29: 
30: 
31: 
32: 
33: 
34: 
35: 
36: 
37: 
38: 
39: 
40: 
41: 
42: 
43: 
44: 
45: 
46: 
47: 
48: 
49: 
50: 
51: 
52: 
// Learn more about F# at http://fsharprogram.net
#light
module BrainFuck
  open System
  open System.Collections.Generic 

  exception UnmatchedBrace of string

  let bf (program:string) (input: unit->char ) (output : char->unit) =
    if program.Length=0 then ()
    let mutable jmps = new Map<int,int>([])
    let mutable  stk = new Stack<char * int>()
    for i = 0 to (program.Length-1) do
      let c = program.[i]
      match c with
       | '[' -> stk.Push((c, i))
       | ']' -> if stk.Count>0 then
                  let (sym,pos)=stk.Peek() 
                  if sym ='[' then
                    jmps <-  jmps.Add(pos , i).Add(i,pos) 
                    ignore stk.Pop
                  else raise(UnmatchedBrace(String.Format(" at pos: {0} ", i)))
                else raise(UnmatchedBrace(String.Format(" at pos: {0} ", i)))
       | _ -> ()
    let mptr = ref 0
    let exit = ref true 
    let   ok = fun(pc)-> !exit && (pc>=0 && pc<program.Length)
    let mem : int[] = Array.zeroCreate 1000
    let rec bfi pc (j:Map<int,int>) =
      if ok pc then 
        match program.[pc] with
          | '[' -> if mem.[!mptr] = 0 then bfi j.[pc] j
          | ']' -> if mem.[!mptr] <> 0 then bfi j.[pc] j
          | '+' -> mem.[!mptr]<-(mem.[!mptr] + 1)
          | '-' -> mem.[!mptr]<-(mem.[!mptr] - 1)
          | '<' -> mptr := !mptr - 1
          | '>' -> mptr := !mptr + 1 
          | '.' -> output(char(mem.[!mptr]))
          | '#' -> mem.[!mptr] <- int( input()) 
          | _ -> ()
        if ok pc then bfi  (pc+1) j
        exit:= false     
    bfi 0 jmps


  let Main() =
    let bfcode = "++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>."
    bf  bfcode (fun ()  -> (char)( Console.Read()) ) (fun(x)->Console.Write((char)x)) 
    let x= Console.ReadKey(false)
    ()

  Main()
module BrainFuck
namespace System
namespace System.Collections
namespace System.Collections.Generic
exception UnmatchedBrace of string

Full name: BrainFuck.UnmatchedBrace
Multiple items
val string : value:'T -> string

Full name: Microsoft.FSharp.Core.Operators.string

--------------------
type string = String

Full name: Microsoft.FSharp.Core.string
val bf : program:string -> input:(unit -> char) -> output:(char -> unit) -> unit

Full name: BrainFuck.bf
val program : string
val input : (unit -> char)
type unit = Unit

Full name: Microsoft.FSharp.Core.unit
Multiple items
val char : value:'T -> char (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.char

--------------------
type char = Char

Full name: Microsoft.FSharp.Core.char
val output : (char -> unit)
property String.Length: int
val mutable jmps : Map<int,int>
Multiple items
module Map

from Microsoft.FSharp.Collections

--------------------
type Map<'Key,'Value (requires comparison)> =
  interface IEnumerable
  interface IComparable
  interface IEnumerable<KeyValuePair<'Key,'Value>>
  interface ICollection<KeyValuePair<'Key,'Value>>
  interface IDictionary<'Key,'Value>
  new : elements:seq<'Key * 'Value> -> Map<'Key,'Value>
  member Add : key:'Key * value:'Value -> Map<'Key,'Value>
  member ContainsKey : key:'Key -> bool
  override Equals : obj -> bool
  member Remove : key:'Key -> Map<'Key,'Value>
  ...

Full name: Microsoft.FSharp.Collections.Map<_,_>

--------------------
new : elements:seq<'Key * 'Value> -> Map<'Key,'Value>
Multiple items
val int : value:'T -> int (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.int

--------------------
type int = int32

Full name: Microsoft.FSharp.Core.int

--------------------
type int<'Measure> = int

Full name: Microsoft.FSharp.Core.int<_>
val mutable stk : Stack<char * int>
Multiple items
type Stack<'T> =
  new : unit -> Stack<'T> + 2 overloads
  member Clear : unit -> unit
  member Contains : item:'T -> bool
  member CopyTo : array:'T[] * arrayIndex:int -> unit
  member Count : int
  member GetEnumerator : unit -> Enumerator<'T>
  member Peek : unit -> 'T
  member Pop : unit -> 'T
  member Push : item:'T -> unit
  member ToArray : unit -> 'T[]
  ...
  nested type Enumerator

Full name: System.Collections.Generic.Stack<_>

--------------------
Stack() : unit
Stack(capacity: int) : unit
Stack(collection: IEnumerable<'T>) : unit
val i : int
val c : char
Stack.Push(item: char * int) : unit
property Stack.Count: int
val sym : char
val pos : int
Stack.Peek() : char * int
member Map.Add : key:'Key * value:'Value -> Map<'Key,'Value>
val ignore : value:'T -> unit

Full name: Microsoft.FSharp.Core.Operators.ignore
Stack.Pop() : char * int
val raise : exn:Exception -> 'T

Full name: Microsoft.FSharp.Core.Operators.raise
Multiple items
type String =
  new : value:char -> string + 7 overloads
  member Chars : int -> char
  member Clone : unit -> obj
  member CompareTo : value:obj -> int + 1 overload
  member Contains : value:string -> bool
  member CopyTo : sourceIndex:int * destination:char[] * destinationIndex:int * count:int -> unit
  member EndsWith : value:string -> bool + 2 overloads
  member Equals : obj:obj -> bool + 2 overloads
  member GetEnumerator : unit -> CharEnumerator
  member GetHashCode : unit -> int
  ...

Full name: System.String

--------------------
String(value: nativeptr<char>) : unit
String(value: nativeptr<sbyte>) : unit
String(value: char []) : unit
String(c: char, count: int) : unit
String(value: nativeptr<char>, startIndex: int, length: int) : unit
String(value: nativeptr<sbyte>, startIndex: int, length: int) : unit
String(value: char [], startIndex: int, length: int) : unit
String(value: nativeptr<sbyte>, startIndex: int, length: int, enc: Text.Encoding) : unit
String.Format(format: string, [<ParamArray>] args: obj []) : string
String.Format(format: string, arg0: obj) : string
String.Format(provider: IFormatProvider, format: string, [<ParamArray>] args: obj []) : string
String.Format(format: string, arg0: obj, arg1: obj) : string
String.Format(format: string, arg0: obj, arg1: obj, arg2: obj) : string
val mptr : int ref
Multiple items
val ref : value:'T -> 'T ref

Full name: Microsoft.FSharp.Core.Operators.ref

--------------------
type 'T ref = Ref<'T>

Full name: Microsoft.FSharp.Core.ref<_>
val exit : bool ref
val ok : (int -> bool)
val pc : int
val mem : int []
type Array =
  member Clone : unit -> obj
  member CopyTo : array:Array * index:int -> unit + 1 overload
  member GetEnumerator : unit -> IEnumerator
  member GetLength : dimension:int -> int
  member GetLongLength : dimension:int -> int64
  member GetLowerBound : dimension:int -> int
  member GetUpperBound : dimension:int -> int
  member GetValue : [<ParamArray>] indices:int[] -> obj + 7 overloads
  member Initialize : unit -> unit
  member IsFixedSize : bool
  ...

Full name: System.Array
val zeroCreate : count:int -> 'T []

Full name: Microsoft.FSharp.Collections.Array.zeroCreate
val bfi : (int -> Map<int,int> -> unit)
val j : Map<int,int>
val Main : unit -> unit

Full name: BrainFuck.Main
val bfcode : string
type Console =
  static member BackgroundColor : ConsoleColor with get, set
  static member Beep : unit -> unit + 1 overload
  static member BufferHeight : int with get, set
  static member BufferWidth : int with get, set
  static member CapsLock : bool
  static member Clear : unit -> unit
  static member CursorLeft : int with get, set
  static member CursorSize : int with get, set
  static member CursorTop : int with get, set
  static member CursorVisible : bool with get, set
  ...

Full name: System.Console
Console.Read() : int
val x : char
Console.Write(value: string) : unit
   (+0 other overloads)
Console.Write(value: obj) : unit
   (+0 other overloads)
Console.Write(value: uint64) : unit
   (+0 other overloads)
Console.Write(value: int64) : unit
   (+0 other overloads)
Console.Write(value: uint32) : unit
   (+0 other overloads)
Console.Write(value: int) : unit
   (+0 other overloads)
Console.Write(value: float32) : unit
   (+0 other overloads)
Console.Write(value: decimal) : unit
   (+0 other overloads)
Console.Write(value: float) : unit
   (+0 other overloads)
Console.Write(buffer: char []) : unit
   (+0 other overloads)
val x : ConsoleKeyInfo
Console.ReadKey() : ConsoleKeyInfo
Console.ReadKey(intercept: bool) : ConsoleKeyInfo
Raw view Test code New version

More information

Link:http://fssnip.net/a0
Posted:12 years ago
Author:Adam Speight
Tags: brainfuck interpretor